home *** CD-ROM | disk | FTP | other *** search
/ Chip 2007 January, February, March & April / Chip-Cover-CD-2007-02.iso / Pakiet bezpieczenstwa / mini Pentoo LiveCD 2006.1 / mpentoo-2006.1.iso / livecd.squashfs / usr / lib / metasploit / msfweb < prev   
Encoding:
Text File  |  2006-06-30  |  64.0 KB  |  2,577 lines
  1. #!/usr/bin/perl
  2. ###############
  3.  
  4. ##
  5. #         Name: msfweb
  6. #       Author: H D Moore <hdm [at] metasploit.com>
  7. #      Version: $Revision: 1.115 $
  8. #  Description: Web interface to the Metasploit Exploit Framework
  9. #      License:
  10. #
  11. #      This file is part of the Metasploit Exploit Framework
  12. #      and is subject to the same licenses and copyrights as
  13. #      the rest of this package.
  14. #
  15. ##
  16.  
  17. require 5.6.0;
  18.  
  19. use strict;
  20. use FindBin qw{$RealBin};
  21. use lib "$RealBin/lib";
  22. use Msf::WebUI;
  23.  
  24. use POSIX;
  25. use IO::Socket;
  26. use Getopt::Std;
  27.  
  28. no utf8;
  29. no locale;
  30.  
  31. Msf::UI::ActiveStateSucks();
  32. Msf::UI::BrokenUTF8();
  33.  
  34. my $ui = Msf::WebUI->new($RealBin);
  35. my $VERSION = $ui->Version;
  36.  
  37. $ui->SetGlobalEnv('_Console', 'Msf::PayloadComponent::WebConsole');
  38.  
  39. my @sections = qw{ EXPLOITS PAYLOADS SESSIONS };
  40.  
  41. my $exploitsIndex;
  42. my $payloadsIndex;
  43. my $encodersIndex;
  44. my $nopsIndex;
  45. my $exploits    = { };
  46. my $payloads    = { };
  47. my $moduleTypes    = { };
  48. my $moduleKeys    = { };
  49. my $moduleArch    = { };
  50. my $moduleOS    = { };
  51. my $moduleList    = { };
  52. my $modules        = { };
  53.  
  54. my $burl;
  55. my %args;
  56.  
  57. # Cache control date
  58. my $cache_start = HTTPDate();
  59. my %cache_hosts = ();
  60.  
  61. # Configuration defaults...
  62. my %config    = 
  63. (
  64.     'BindAddr'    => '127.0.0.1',
  65.     'BindPort'    => 55555,
  66.     'LogFile'    => '-',
  67.     'LogLevel'    => 0,
  68.     'Reload'    => 0,
  69.     'Theme'        => 'default',
  70.     'ThemeDir'    => "$RealBin/data/msfweb/themes",
  71.     'IconDir'    => "$RealBin/data/msfweb/icons",
  72.     'CacheDir'    => $ui->_DotMsfDir. "/msfweb",    
  73.     'Defanged'    => 0,
  74. );
  75.  
  76.  
  77. # Process the command line options
  78. getopts("a:l:v:p:t:T:C:r:hD", \%args);
  79.  
  80. # Show the help output
  81. if ($args{'h'}) { Usage() }
  82.  
  83.  
  84. # IP address and possible TCP port
  85. if (exists($args{'a'}))
  86. {
  87.     my ($host, $port) = split(/:/, $args{'a'});
  88.     $config{'BindAddr'} = $host;
  89.     
  90.     if ($port) {
  91.         $config{'BindPort'} = $port;
  92.     }
  93. }
  94.  
  95. # TCP port
  96. if (exists($args{'p'})) {
  97.     $config{'BindPort'} = $args{'p'};
  98. }
  99.  
  100. # Log file name
  101. if (exists($args{'l'})) {
  102.     $config{'LogFile'} = $args{'l'};
  103. }
  104.  
  105. # Log verbosity level
  106. if (exists($args{'v'})) {
  107.     $config{'LogLevel'} = $args{'v'};
  108. }
  109.  
  110. # Theme name
  111. if (exists($args{'t'})) {
  112.     $config{'Theme'} = $args{'t'};
  113. }
  114.  
  115. # Theme directory
  116. if (exists($args{'T'})) {
  117.     $config{'ThemeDir'} = $args{'T'};
  118. }
  119.  
  120. # Cache directory
  121. if (exists($args{'C'})) {
  122.     $config{'CacheDir'} = $args{'C'};
  123. }
  124.  
  125. # Reload modules
  126. if (exists($args{'r'})) {
  127.     $config{'Reload'}++;
  128. }
  129.  
  130. # Check for 'defanged' option
  131. if (exists($args{'D'})) {
  132.     $config{'Defanged'}++;
  133. }
  134.  
  135. my $bindstr = $config{'BindAddr'}. ':' .$config{'BindPort'};
  136. print STDERR "+----=[ Metasploit Framework Web Interface ($bindstr)\n\n";
  137.  
  138. # Create the .msf directory if it does not exist
  139. if (! -d $ui->_DotMsfDir) {
  140.     mkdir($ui->_DotMsfDir, 0700);
  141. };
  142.  
  143. # Create the cache directory if it does not exist
  144. if (! -d $config{'CacheDir'}) {
  145.     mkdir($config{'CacheDir'}, 0700);
  146. }
  147.  
  148. # Check to see if we can write files to the cache directory
  149. if (! -d $config{'CacheDir'} || ! open(T, ">>".$config{'CacheDir'}.'/.test_'.$$) ) {
  150.     print STDERR "ERROR: the specified cache directory is not accessible: $!\n";
  151.     exit(1);
  152. }
  153. unlink($config{'CacheDir'}.'/.test_'.$$) && close(T);
  154. $ui->SetTempEnv('_CacheDir', $config{'CacheDir'} );
  155.  
  156. # Create a cache prefix based on the master pid
  157. # This prevents locking issues in Cygwin...
  158. $ui->SetTempEnv('_CachePath', sprintf('%s/%.4x_', $config{'CacheDir'}, $$));
  159.  
  160. # XXX Clear old session logs on startup
  161.  
  162. # Verify that the specified theme actually exists
  163. if (! -r  $config{'ThemeDir'} .'/'. $config{'Theme'} .'/style.css') {
  164.     print STDERR "ERROR: the specified theme does not exist\n";
  165.     exit(1);
  166. }
  167. $ui->SetTempEnv('_Theme', $config{'ThemeDir'} .'/'. $config{'Theme'} );
  168.  
  169.  
  170. # Verify that the icon directory exists
  171. if (! -r  $config{'IconDir'} .'/win32.gif') {
  172.     print STDERR "ERROR: the specified icon directory does not exist\n";
  173.     exit(1);
  174. }
  175. $ui->SetTempEnv('_IconDir', $config{'IconDir'});
  176.  
  177.  
  178. # Set defanged mode if needed...
  179. $ui->SetTempEnv('_Defanged', $config{'Defanged'});
  180.  
  181.  
  182. # Create the inital list of modules
  183. LoadAllModules();
  184.  
  185. # Pregenerate the complete lists without any filters
  186. if (! $config{'Reload'} ) {
  187.     ExploitList();
  188.     PayloadList();
  189. }
  190.  
  191. my $ghettoWeb = GhettoWeb->new
  192. (
  193.     'host'    => $config{'BindAddr'},
  194.     'port'    => $config{'BindPort'},
  195.     'fnWeb'    => \&ProcessWebRequest,
  196.     'fnIPC'    => \&ProcessIPCRequest,
  197.     'fnHRP'    => \&HTTPRequest,
  198. );
  199.  
  200. $ghettoWeb->LogFile($config{'LogFile'});
  201. $ghettoWeb->LogLevel($config{'LogLevel'});
  202.  
  203. $ghettoWeb->Run();
  204.  
  205. if ($ghettoWeb->IsError) {
  206.     print STDERR "[*] Error: ".$ghettoWeb->GetError."\n";
  207. }
  208.  
  209.  
  210. exit(0);
  211.  
  212.  
  213. ########################################################
  214. #                 !!! WARNING !!!                      #
  215. #                                                      #
  216. #    Viewing the code below may result in the loss     #
  217. #    of vision, nausea, indigestion, insomnia, or      #
  218. #    even INSTANT DEATH. You have been warned.         #
  219. #                                                      #
  220. ########################################################
  221.  
  222. ######################################################################
  223. ######################################################################
  224. ######################################################################
  225.  
  226. sub Usage {
  227.     print STDERR qq{
  228. Usage: $0 <options>
  229.  
  230. Options:
  231.     -a    <ip address>  Bind to this IP instead of the loopback address
  232.     -p    <tcp port>    Bind to this TCP port instead of 55555
  233.     -l    <log file>    The path name to use for a log file (stderr)
  234.     -v    <log level>   A number between 0 and 10 that controls log verbosity
  235.     -t    <theme name>  Select a specific theme: default, gwhite, gblack
  236.     -T    <theme dir>   Use an alternate directory for msfweb themes
  237.     -C    <cache dir>   Use a specific directory for session cache files
  238.     -r    <boolean>     Reload all modules with each new web request
  239.  
  240. };
  241.     exit(0);
  242. }
  243.  
  244. sub ProcessResRequest {
  245.     my ($req, $cli, $ipc) = @_;
  246.     my ($is_icon, $is_theme);
  247.  
  248.     # Process requests for shared icons
  249.     if (exists($req->{'params'}->{'ICON'})) {
  250.         my $os = $req->{'params'}->{'ICON'};
  251.         my $icondir = $ui->GetTempEnv('_IconDir') || "$RealBin/data/msfweb/icons";
  252.         
  253.         my %icons =
  254.         (
  255.             'aix'    => ['image/gif', 'aix.gif'],
  256.             'amiga'    => ['image/gif', 'amiga.gif'],    
  257.             'beos'    => ['image/gif', 'be.gif'],
  258.             'bsd'    => ['image/gif', 'bsd.gif'],
  259.             'cisco'    => ['image/gif', 'cisco.gif'],
  260.             'hpux'    => ['image/gif', 'hpux.gif'],
  261.             'irix'    => ['image/gif', 'irix.gif'],
  262.             'linux'    => ['image/gif', 'linux.gif'],
  263.             'novell'=> ['image/gif', 'novell.gif'],                        
  264.             'os2'    => ['image/gif', 'os2.gif'],
  265.             'osx'    => ['image/gif', 'osx.gif'],
  266.             'sun'    => ['image/gif', 'sun.gif'],
  267.             'win32'    => ['image/gif', 'win32.gif'],
  268.  
  269.             # special case icons
  270.             'any'        => ['image/gif', 'any.gif'],
  271.             'unknown'    => ['image/gif', 'unknown.gif'],
  272.             'favorite'    => ['image/x-icon', 'favicon.ico'],
  273.         );
  274.         
  275.         my ($type, $path) = @{ $icons{$os} || $icons{'unknown'} };
  276.         my $data;
  277.         
  278.         if ( open (X, "<$icondir/$path") ) {
  279.             binmode (X);
  280.             while (<X>) { $data .= $_ }
  281.             close (X);
  282.         }
  283.  
  284.         $cli->Send(HTTPResponse(200, $data, $type));
  285.         return;
  286.     }
  287.  
  288.     # Process requests for theme-based resources
  289.     if (exists($req->{'params'}->{'ID'})) {
  290.         my $theme = $ui->GetTempEnv('_Theme') || "$RealBin/data/msfweb/themes/default";    
  291.         my %files =
  292.         (
  293.             'LOGO'    => ['image/jpg', 'logo.jpg'],
  294.             'STYLE'    => ['text/css',  'style.css'],
  295.         );
  296.  
  297.         if ( exists( $files{ $req->{'params'}->{'ID'} } ) ) {
  298.             my ($type, $path) = @{ $files{ $req->{'params'}->{'ID'} } };
  299.             my $data;
  300.  
  301.             if ( open (X, "<$theme/$path") ) {
  302.                 binmode (X);
  303.                 while (<X>) { $data .= $_ }
  304.                 close (X);
  305.             }
  306.  
  307.             $cli->Send(HTTPResponse(200, $data, $type));
  308.         }
  309.         return;
  310.     }
  311. }
  312.  
  313.  
  314. sub ProcessIPCRequest {
  315.     my $self    = shift;
  316.     my $ipc        = shift;
  317.  
  318.     my $req = $ipc->getline || return;
  319.     chomp($req);
  320.     
  321.     my ($cmd, @args) = split(/\s+/, $req);
  322.     $self->Log(3, "IPC: $ipc $$ $cmd ($args[0] | $args[1])");
  323.     
  324.     return if ! $cmd;
  325.     
  326.     
  327.     if ($cmd eq 'SESSION') {
  328.         my $sid = $self->SessionNew($ipc);
  329.         $ipc->printflush("SID $sid\n");
  330.  
  331.     }
  332.     
  333.     # NEW <sid> <pid of exploit pipe handler>
  334.     if ($cmd eq 'NEW') {
  335.         $self->SessionPipePID(@args);
  336.         $ipc->printflush("SHELL\n");
  337.     }
  338.     
  339.     if ($cmd eq 'SHUTDOWN') {
  340.         $ipc->printflush("SHUTDOWN\n");
  341.         $self->SessionRemove($args[0]);
  342.     }
  343.     
  344.     if ($cmd eq 'CMD' || $cmd eq 'DATA') {
  345.         my $out = $self->SessionIPC($args[0]);
  346.         if ($out) {
  347.             $out->printflush("$cmd ".$args[1]."\n");
  348.             $ipc->printflush("$cmd OK\n");
  349.         }
  350.         else {
  351.             $ipc->printflush("$cmd ERROR\n");
  352.         }
  353.  
  354.     }
  355.     
  356.     if ($cmd eq 'INFO') {
  357.         $self->SessionInfo($args[0], $args[1]);
  358.     }
  359.     
  360.     # XXX replace this :/
  361.     if ($cmd eq 'LIST') {
  362.         my @list = $self->SessionList();
  363.         my $data;
  364.         foreach my $sid (@list) {
  365.             $data .= 'sid='. unpack('H*', $sid). ',' .$self->SessionInfo($sid). ' ';
  366.         }
  367.         $ipc->printflush("LIST $data\n");
  368.     }
  369. }
  370.  
  371. sub ProcessWebRequest {
  372.     my $self = shift;
  373.     my ($req, $cli, $ipc) = @_;
  374.     my $state = $req->{'params'};
  375.     my $mbase = $req->{'base'};
  376.     my $res;
  377.         
  378.     my $cinfo = $cli->PeerAddr .':'. $cli->PeerPort;
  379.     my $log = "HTTP: $cinfo $$ ". $req->{'path'} ." ". $state->{'MODE'};
  380.     
  381.     
  382.     # Dirty hack to support /favicon.ico requests
  383.     if ($req->{'path'} eq '/favicon.ico') {
  384.         $req->{'path'} = '/RESOURCE?ICON=favorite';
  385.         $req->{'base'} = 'RESOURCE';
  386.         $state->{'ICON'} = 'favorite';
  387.     }
  388.     
  389.     if (exists($state->{'MODULE'})) {
  390.         $log .= " module=". $state->{'MODULE'};
  391.     }
  392.     
  393.     if ($req->{'base'} eq 'RESOURCE') {
  394.         $log .= " ICON=". $state->{'ICON'} if $state->{'ICON'};
  395.         $log .= " ID=". $state->{'ID'} if $state->{'ID'};        
  396.     }
  397.  
  398.     $self->Log(3, $log);
  399.         
  400.     # Process resource requests
  401.     if ($req->{'base'} eq 'RESOURCE') {
  402.         ProcessResRequest($req, $cli, $ipc);
  403.         exit(0);
  404.     }
  405.  
  406.     # Generate the base URL
  407.     $burl = "/$mbase?";
  408.     
  409.     # Reload all modules only when the -r option has been specified
  410.     if ($config{'Reload'}) {
  411.         LoadAllModules();
  412.     }
  413.     
  414.     # Start with a standard header
  415.     $res .= HTML_Header($req);
  416.     
  417.     my $logaction;
  418.     if (defined (my $mid = $state->{'MODULE'} )) {
  419.  
  420.         my $mname;
  421.         my $icons;
  422.                         
  423.         if ($mbase eq 'EXPLOITS' && exists($exploits->{$mid}) ) {
  424.             $mname = $exploits->{$mid}->Name;
  425.             $mname .= ' ('.$state->{'PAYLOAD'}.')' if exists($state->{'PAYLOAD'});
  426.             
  427.             foreach ( KeysToIcons( @{ $exploits->{$mid}->OS } ) ) {
  428.                 $icons  .= "<img src='/RESOURCE?ICON=$_' border=0 class='iconset' alt='$_'> ";
  429.             }
  430.         }
  431.         
  432.         if ($mbase eq 'PAYLOADS' && exists($payloads->{$mid}) ) {
  433.             $mname = $payloads->{$mid}->Name;
  434.             foreach ( KeysToIcons( @{ $payloads->{$mid}->OS } ) ) {
  435.                 $icons  .= "<img src='/RESOURCE?ICON=$_' border=0 class='iconset' alt='$_'> ";
  436.             }            
  437.         }
  438.         
  439.         if (! defined($mname)) {
  440.             $mname = 'Invalid Module';
  441.         }                        
  442.  
  443.         $res .= "<table width='100%' cellspacing=0 border=0 cellpadding=0>\n";
  444.         $res .= "<tr><td class='moduleIcons' align='center'>$icons</td>";
  445.         $res .= "<td class='moduleName'><div class='textBold'>$mname</div></td></tr>\n";
  446.         $res .= "</table><br>\n";
  447.     }
  448.  
  449.     $state->{'client'} = $cli;
  450.     $state->{'parent'} = $ipc;
  451.     
  452.  
  453.     
  454.                             
  455.     if ($req->{'base'} eq 'EXPLOITS') {
  456.         
  457.         if ($state->{'MODE'} eq 'MAIN')    { $res .= ExploitList($state) }
  458.         if ($state->{'MODE'} eq 'SELECT')  { $res .= ExploitTarget($state) }
  459.         if ($state->{'MODE'} eq 'PAYLOAD') { $res .= ExploitPayload($state) }
  460.         if ($state->{'MODE'} eq 'OPTIONS') { $res .= ExploitOptions($state) }
  461.         if ($state->{'MODE'} eq 'TARGETS') { $res .= ExploitTargets($state) }
  462.         if ($state->{'MODE'} eq 'CHECK')   { $res .= ExploitCheck($state) }
  463.  
  464.         # ExploitExec doesn't return on success
  465.         if ($state->{'MODE'} eq 'EXPLOIT') { $res .= ExploitExec($state) }
  466.  
  467.         $res .= HTML_Footer();  
  468.     }
  469.  
  470.     if ($req->{'base'} eq 'PAYLOADS') {
  471.     
  472.         if ($state->{'MODE'} eq 'MAIN')      { $res .= PayloadList($state) }
  473.         if ($state->{'MODE'} eq 'SELECT')    { $res .= PayloadOptions($state) }
  474.         if ($state->{'MODE'} eq 'GENERATE')  { $res .= PayloadGenerate($state) }
  475.         $res .= HTML_Footer();
  476.     }
  477.     
  478.     if ($req->{'base'} eq 'SESSIONS') {
  479.     
  480.         if ($state->{'MODE'} eq 'MAIN')      { $res .= SessionList($state) }
  481.         if ($state->{'MODE'} eq 'LOAD')      { $res = SessionLoad($state) }
  482.         if ($state->{'MODE'} eq 'COMMAND')   { $res = SessionCommand($state) }
  483.         if ($state->{'MODE'} eq 'UPDATE')    { $res = SessionUpdate($state) }
  484.     }    
  485.             
  486.     
  487.     
  488.     $cli->Send(HTTPResponse(200, $res));
  489.     $cli->Close();
  490.     
  491.     exit(0);
  492. }
  493.  
  494.  
  495. sub HTML_Header {
  496.     my $req = shift;
  497.     
  498.     my $header = qq
  499. [<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
  500. <html>
  501.     <head>
  502.         <title>Metasploit Framework Web Console v$VERSION</title>
  503.         <link type='text/css' rel='stylesheet' href='/RESOURCE?ID=STYLE'>
  504.          <meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1">
  505.     </head>
  506.     <body>
  507.     <br>
  508.     
  509.     <div align='center'><img src='/RESOURCE?ID=LOGO' alt='msfweb'></div>
  510.     <br>
  511.     
  512.     <table align='center' cellpadding=8 border=0 cellspacing=1 width='100%' class='tblInner'>
  513.         <tr><td>
  514.             <table align='center' cellpadding=8 cellspacing=1 width='100%' class='tblOuter' >
  515.             <tr>
  516. ];
  517.  
  518.     my $lastTab = 'tabLight';
  519.     my $currTab;
  520.     
  521.     $header .= "\t\t\t";
  522.     
  523.     my $width = int( 100 / scalar(@sections) ) .'%';
  524.     foreach my $section (@sections) {
  525.         $lastTab = ($lastTab eq 'tabLight') ? 'tabDark' : 'tabLight';
  526.         $currTab = ($section eq $req->{'base'}) ? 'tabActive' : $lastTab;        
  527.         $header .= qq[ <td class='$lastTab' width='$width' align='center'> <a href='/$section' class='$currTab'>$section</a> </td> ];
  528.     }
  529.     $header .= qq[
  530.             </tr>
  531.             </table>
  532.         </td></tr>
  533.  
  534.         <tr><td colspan=5>
  535.         <br>
  536.     ];
  537.     
  538.     return $header;
  539.  
  540. }
  541.  
  542. sub HTML_Footer {
  543.     return qq[
  544.         <br>
  545.         </td>
  546.     </tr>
  547. </table>
  548.  
  549. <div align='center' class='copy'>
  550.     <br>copyright © 2003-2005 metasploit.com<br><br>
  551. </div>
  552. </body>
  553. </html>
  554.     ];
  555. }
  556.  
  557.  
  558. sub KeysToIcons {
  559.     my @keys = @_;
  560.     my %icons;
  561.     my %match;
  562.     
  563.     @icons { qw { aix amiga beos bsd cisco hpux irix linux novell os2 osx sun win32 unknown } } = ();
  564.     my %osmaps =
  565.     (
  566.         'solaris'    => 'sun',
  567.         'ios'        => 'cisco',
  568.         'openbsd'    => 'bsd',
  569.         'freebsd'    => 'bsd',
  570.         'netbsd'    => 'bsd',
  571.         'bsdi'        => 'bsd',
  572.         'macos'        => 'mac',
  573.     );
  574.  
  575.     if (! scalar(@keys) ) {
  576.         return ('any');
  577.     }
  578.  
  579.     foreach (@keys) {
  580.         $match{ $_ }++ if exists($icons{$_});
  581.         $match{ $osmaps{ $_ } }++ if exists($icons{ $osmaps{ $_ } });
  582.     }
  583.     
  584.     if (! scalar(keys %match)) {
  585.         $match{'unknown'}++;
  586.     }
  587.  
  588.     return sort keys %match;
  589. }
  590.  
  591. sub URLEncode {
  592.     my ($data) = @_;
  593.     my $res;
  594.     foreach (split(//, $data))  
  595.     { $res .= sprintf("%%%.2x", ord($_)) }
  596.     return $res;
  597. }
  598.  
  599. sub StateToURL {
  600.     my ($mode, $state) = @_;
  601.     my (%tmp, $res);
  602.     $res = $burl;
  603.     
  604.     foreach (keys(%{$state})) {
  605.         next if $_ eq "client";
  606.         next if $_ eq "parent";
  607.         
  608.         my $value = $_ eq "MODE" ? $mode : $state->{$_};
  609.         $res .= $_ . "=" . URLEncode($value) . "&";
  610.     }
  611.     return $res;
  612. }
  613.  
  614. sub StateToOptions {
  615.     my ($state) = @_;
  616.     my $res = {};
  617.     
  618.     foreach (keys(%{$state})) {
  619.         if (m/^OPT\_(.*)/ && defined($state->{$_})) {
  620.             my $name = $1;
  621.             
  622.             # Block all options starting with underscore (thanks Dino!)
  623.             if ($name !~ /^_/) {
  624.                 $res->{$name} = $state->{$_};
  625.             }
  626.             else {
  627.                 # XXX - report a possible "refang" attack?
  628.                 next;
  629.             }
  630.         }
  631.     }
  632.     return $res;
  633. }
  634.  
  635. sub SessionList { 
  636.     my $state    = shift;
  637.     my $ipc        = $state->{'parent'}; 
  638.     my $res;
  639.     
  640.     my %slist;
  641.     $ipc->printflush("LIST\n");
  642.     
  643.     if ( defined(my $raw = $ipc->getline) ) {
  644.         if ( (my ($data) = $raw =~ m/^LIST\s+(.*)\n/) ) {
  645.             foreach my $entry (split(/\s+/, $data)) {
  646.                 my %hash = IPCDataToHash($entry);
  647.                 my $sid = $hash{'sid'};
  648.                 $slist{$sid} = \%hash;
  649.             }
  650.         }
  651.     }
  652.     
  653.     if (! scalar(keys(%slist))) {
  654.         $res .= "<p class='textBold'>There are no active sessions.<br\><br\></p>\n";
  655.         $res .= HTML_Footer();
  656.         return $res;
  657.     }
  658.  
  659.     $res .= "<p class='textBold'>Session List:<br\><br\></p>\n";
  660.     $res .= "<table align='center' cellpadding=0 border=0 cellspacing=0 width='95%'>\n";
  661.     $res .= "<tr>";
  662.     
  663.     foreach (qw{Time Session User Exploit Target Payload}) {
  664.         $res .= "<td class='textBold' align='center'>$_</td>";
  665.     }
  666.     
  667.     $res .= "</tr><tr><td colspan=6><br\></td></tr>\n";
  668.  
  669.     foreach my $sid (sort { $a <=> $b } keys %slist ) {
  670.         my $ses            = $slist{$sid};
  671.         my $s_module    = $ses->{'module'};
  672.         my $s_payload    = $ses->{'payload'};
  673.         my $s_client    = $ses->{'client'};
  674.         my $s_target    = $ses->{'target'};
  675.         my $s_time        = scalar(localtime($ses->{'start'}));
  676.         
  677.         my $mlink = '/EXPLOITS?MODE=SELECT&MODULE='.URLEncode($s_module);
  678.         my $plink = ($s_payload ne 'unknown') ? '/PAYLOADS?MODE=SELECT&MODULE='.URLEncode($s_payload) : '#';
  679.         
  680.         $res .= "<tr>";
  681.         $res .= "<td class='textNormal'>$s_time</td>";
  682.         $res .= "<td class='textNormal'><a href='/SESSIONS?MODE=LOAD&SID=$sid' target='_blank'>Session $sid</a></td>";
  683.         $res .= "<td class='textNormal'>$s_client</td>";
  684.         $res .= "<td class='textNormal'><a href='$mlink'>$s_module</a></td>";
  685.         $res .= "<td class='textNormal'>$s_target</td>";
  686.         $res .= "<td class='textNormal'><a href='$plink'>$s_payload</a></td>";
  687.         $res .= "</tr>";
  688.     }
  689.     
  690.     $res .= "</table>\n";
  691.     $res .= HTML_Footer();
  692.     return $res;
  693. }
  694.  
  695. sub SessionLoad { 
  696.     my $state    = shift;
  697.     my $sid        = $state->{'SID'} + 0;
  698.     my $res        = qq
  699. [<html>
  700.     <head>
  701.         <title>Metasploit Framework v$VERSION - Session $sid </title>
  702.         <link type='text/css' rel='stylesheet' href='/RESOURCE?ID=STYLE'>
  703.     </head>
  704. <frameset rows="*, 90" border=0 frameborder=0 framespacing=0>
  705.   <frame src="/SESSIONS?MODE=UPDATE&SID=$sid" name="update">
  706.   <frame src="/SESSIONS?MODE=COMMAND&SID=$sid" name="command">
  707.   <noframes><body>This feature requires frames...</body></noframes>
  708. </frameset>
  709. ];
  710.     
  711.     return $res;
  712. }
  713.  
  714. # Quick command bar to send commands to the shell
  715. sub SessionCommand { 
  716.     my $state    = shift;
  717.     my $data    = $state->{'IDATA'};    
  718.     my $ipc        = $state->{'parent'};    
  719.     my $sid        = $state->{'SID'} + 0;
  720.     my $cmd        = $state->{'CMD'};
  721.     my $cmdurl    = "/SESSIONS?MODE=COMMAND&SID=$sid&CMD=";
  722.  
  723.     my $lspace  = " " x 4;
  724.     my $verify    = 'javascript:if(!confirm("Are you sure that you want to kill this session?")){return false; }';
  725.     my $cmdbar    =
  726.     "<div class='textBold' class='CommandBar'>\n".
  727.     "<ul id='CommandBarList'>\n".
  728.     "<li>Session Commands:$lspace".
  729.     "<li><a href='".$cmdurl."DIE' onClick='$verify'>Session::Kill</a>$lspace".
  730.     "<li><a href='".$cmdurl."INT'>Session::Break</a>$lspace".
  731.     "<li><a href='http://metasploit.com/' target='_blank'>Metasploit::Website</a>$lspace".
  732.     "<li><a href='http://metasploit.com/donate.html' target='_blank'>Metasploit::Donate</a> ".        
  733.     "</ul>\n".
  734.     "</div>";
  735.         
  736.     my $res        = qq
  737. [<html>
  738.     <head>
  739.         <title>Metasploit Framework Web Console v$VERSION</title>
  740.         <link type='text/css' rel='stylesheet' href='/RESOURCE?ID=STYLE'>
  741.     </head>
  742. <body>
  743.  
  744. <form action='/SESSIONS' name='cmdform'>
  745. <input type='hidden' name='MODE' value='COMMAND'>
  746. <input type='hidden' name='SID' value='$sid'>
  747.  
  748. <input type='text'   name='IDATA' size=80 maxsize=4000>
  749. <input type='submit' name='RUN'  value='Run' class='button'>
  750. </form>
  751. $cmdbar
  752. <script language='javascript'>
  753. <!--
  754.     window.focus();
  755.     document.cmdform.IDATA.value="";    
  756.     document.cmdform.IDATA.focus();
  757. //-->
  758. </script>
  759. </body>
  760. </html>
  761. ];
  762.     
  763.     # Process any special command sequences
  764.     if ($cmd) {
  765.         $ipc->printflush("CMD $sid ".unpack("H*", $cmd)."\n");
  766.         my $raw = $ipc->getline;
  767.         
  768.         if ($raw =~ /ERROR/) {
  769.             $ipc->printflush("SHUTDOWN $sid\n");
  770.         }    
  771.     }
  772.     # Process incoming data (shell commands)...
  773.     elsif ($data) {
  774.         $data .= "\n";
  775.         $ipc->printflush("DATA $sid ".unpack("H*", $data)."\n");
  776.         my $raw = $ipc->getline;
  777.         
  778.         if ($raw =~ /ERROR/) {
  779.             $ipc->printflush("SHUTDOWN $sid\n");
  780.         }
  781.     }
  782.  
  783.     return $res;
  784. }
  785.  
  786. sub SessionUpdate { 
  787.     my $state    = shift;
  788.     my $ipc        = $state->{'parent'};
  789.     my $chi        = $state->{'client'};
  790.     my $sid        = $state->{'SID'} + 0;
  791.     my $cmd        = $state->{'CMD'};
  792.  
  793.     my $res        = qq
  794. [<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
  795. <html>
  796.     <head>
  797.         <title>Metasploit Framework Web Shell v$VERSION - Session $sid </title>
  798.         <link type='text/css' rel='stylesheet' href='/RESOURCE?ID=STYLE'>
  799.          <meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1">
  800.     </head>
  801.     <body>
  802.     <pre>
  803. ];
  804.  
  805.     # Use chunked transfer mode to return partial responses
  806.     my $out = "HTTP/1.1 200 OK\r\n".
  807.               "Connection: close\r\n".
  808.               "Date: ". HTTPDate()."\r\n".
  809.               "Content-Type: text/html\r\n".
  810.               "Transfer-Encoding: chunked\r\n\r\n";
  811.     
  812.     $chi->Send($out);
  813.     $chi->Send(sprintf("%x\r\n%s\r\n", length($res), $res));
  814.     
  815.     my $init = 0;
  816.     my $foff = 0;
  817.     my $idle = 0;
  818.     my $tick = time();
  819.     
  820.     my $cache_file = $ui->GetEnv('_CachePath'). sprintf("cache%.8x.dat", $sid);
  821.     my $cache_data;
  822.  
  823.     my $count = 10;
  824.     while ($count && ! open(CACHE, "<$cache_file")) {
  825.         sleep(1);
  826.         $count--;
  827.     }
  828.     
  829.     if (! $count) {
  830.         $res  = "<div class='textBold'>!!! Timeout reached waiting for the session log</div>\n";
  831.         $res .= "</pre></body></html>\n";
  832.         $chi->Send(sprintf("%x\r\n%s\r\n", length($res), $res));
  833.         exit(0);
  834.     }
  835.     
  836.     binmode(CACHE);
  837.     
  838.     while (1) {
  839.         $res = undef;
  840.         
  841.         if (! $chi->Socket->connected) {
  842.             exit(0);
  843.         }
  844.         
  845.         # Read the init time stamp from the top
  846.         seek(FILE, 0, 0);
  847.         my $init_data = <CACHE>;
  848.         
  849.         # Seek to the last data marker
  850.         seek(CACHE, $foff, 0);
  851.         
  852.         # Read until we hit EOF
  853.         for ($foff = tell(CACHE); my $data = <CACHE>; $foff = tell(CACHE)) {
  854.             $res .= $data;
  855.         }
  856.         
  857.         # Clear stdio errors and seek to the last tell
  858.         seek(CACHE, $foff, 1);
  859.         seek(CACHE, $foff, 0);
  860.  
  861.         # If there is a new data, display it
  862.         if ($res) {
  863.             $res .= "<script language='javascript'>self.scrollTo(0, 999999999)</script>";
  864.             $chi->Send(sprintf("%x\r\n%s\r\n", length($res), $res));
  865.             $tick = time();
  866.             $idle = 0;
  867.         }
  868.         
  869.         # Send a comment as a keep alive
  870.         if ($tick + 10 < time()) {
  871.             $res = "<!-- MSF -->";
  872.             $chi->Send(sprintf("%x\r\n%s\r\n", length($res), $res));
  873.             $tick = time();
  874.             $idle++;
  875.         }
  876.         
  877.         # If we have been idle for five minutes, shut down the reader
  878.         if ($idle > 30) {
  879.             $res =  "<div class='textBold'>!!! Idle timeout reached, reload to start again.</div>\n";
  880.             $res .= "</pre></body></html>\n";
  881.             $chi->Send(sprintf("%x\r\n%s\r\n", length($res), $res));
  882.             exit(0);
  883.         }
  884.         
  885.         # Sleep a quarter of a second to reduce CPU usage 
  886.         select(undef, undef, undef, 0.25);
  887.     }
  888.     
  889.     $res = "</pre></body></html>\n";
  890.     $chi->Send(sprintf("%x\r\n%s\r\n", length($res), $res));
  891.     exit(0);
  892. }
  893.  
  894.  
  895. sub PayloadList {
  896.     my $state = shift;
  897.     my $mtype = 'payloads';
  898.     my $mfilt = exists($state->{'FILTER'}) ? $state->{'FILTER'} : 'ALL';
  899.     
  900.     if (! $config{'Reload'} || ! defined( $moduleList->{$mtype}->{$mfilt} )) {
  901.         $moduleList->{$mtype}->{$mfilt} = ModuleList($mtype, $mfilt);
  902.     } 
  903.     return $moduleList->{$mtype}->{$mfilt};
  904. }
  905.  
  906. sub ExploitList {
  907.     my $state = shift;
  908.     my $mtype = 'exploits';
  909.     my $mfilt = exists($state->{'FILTER'}) ? $state->{'FILTER'} : 'ALL';
  910.     
  911.     if (! $config{'Reload'} || ! defined( $moduleList->{$mtype}->{$mfilt} )) {
  912.         $moduleList->{$mtype}->{$mfilt} = ModuleList($mtype, $mfilt);
  913.     } 
  914.     return $moduleList->{$mtype}->{$mfilt};
  915. }
  916.  
  917. sub ModuleList
  918. {
  919.     my $mtype = shift;
  920.     my $mfilt = shift;
  921.     my $mList;
  922.     my @links;
  923.     
  924.     my $moduleMerge = {};
  925.  
  926.     my $mTypes        = $moduleTypes->{$mtype};
  927.     my $mKeys        = $moduleKeys->{$mtype};
  928.     my $mArch        = $moduleArch->{$mtype};
  929.     my $mOS            = $moduleOS->{$mtype};    
  930.     my $mALL        = {};
  931.  
  932.  
  933.     $mList  = "<form action='/".uc($mtype)."' method='GET'>\n";
  934.     $mList .= "<div align='center' class='navHead'>\n";
  935.     $mList .= "<select name='FILTER' onChange='javascript:form.submit()'>\n";
  936.     $mList .= "<option value='ALL'> \n";
  937.  
  938.     # List of mTypes
  939.     if ($mtype eq 'exploits' && scalar(keys %{ $mTypes } )) {
  940.         $mList .= "<option value='ALL'>--- Exploit Class ---\n";
  941.         foreach my $kname  (sort( keys %{ $mTypes }) ) {
  942.             my $sel = ($mfilt eq $kname) ? 'SELECTED' : '';
  943.             $mList .= "<option value='$kname' $sel> class :: $kname\n";
  944.             $moduleMerge->{$kname} = $mTypes->{$kname};
  945.             if ($mfilt eq 'ALL') {
  946.                 foreach my $mname (@{ $mTypes->{$kname} }) {
  947.                     $mALL->{$mname}++;
  948.                 }
  949.             }
  950.         }
  951.     }
  952.     
  953.     # List of mKeys
  954.     if (scalar(keys %{ $mKeys } )) {
  955.         $mList .= "<option value='ALL'> \n";
  956.         $mList .= "<option value='ALL'>--- Application ---\n";
  957.         foreach my $kname  (sort( keys %{ $mKeys }) ) {
  958.             my $sel = ($mfilt eq $kname) ? 'SELECTED' : '';
  959.             $mList .= "<option value='$kname' $sel> app :: $kname\n";
  960.             $moduleMerge->{$kname} = $mKeys->{$kname};
  961.             if ($mfilt eq 'ALL') {
  962.                 foreach my $mname (@{ $mKeys->{$kname} }) {
  963.                     $mALL->{$mname}++;
  964.                 }
  965.             }
  966.         }
  967.     }
  968.     
  969.     # List of mOS
  970.     if (scalar(keys %{ $mOS } )) {
  971.         $mList .= "<option value='ALL'> \n";    
  972.         $mList .= "<option value='ALL'>--- Operating System ---\n";    
  973.         foreach my $kname (sort( keys %{ $mOS }) ) {
  974.             my $sel = ($mfilt eq $kname) ? 'SELECTED' : '';        
  975.             $mList .= "<option value='$kname' $sel> os :: $kname\n";
  976.             $moduleMerge->{$kname} = $mOS->{$kname};
  977.             if ($mfilt eq 'ALL') {
  978.                 foreach my $mname (@{ $mOS->{$kname} }) {
  979.                     $mALL->{$mname}++;
  980.                 }
  981.             }            
  982.         }
  983.     }
  984.  
  985.     # List of mArch
  986.     if (scalar(keys %{ $mArch } )) {
  987.         $mList .= "<option value='ALL'> \n";    
  988.         $mList .= "<option value='ALL'>--- Architecture  ---\n";
  989.         foreach my $kname (sort( keys %{ $mArch}) ) {
  990.             my $sel = ($mfilt eq $kname) ? 'SELECTED' : '';        
  991.             $mList .= "<option value='$kname' $sel> cpu :: $kname\n";
  992.             $moduleMerge->{$kname} = $mArch->{$kname};
  993.             if ($mfilt eq 'ALL') {
  994.                 foreach my $mname (@{ $mArch->{$kname} }) {
  995.                     $mALL->{$mname}++;
  996.                 }
  997.             }        
  998.         }
  999.         $mList .= "</select>\n";
  1000.     }
  1001.     
  1002.     $mList .= "<input type='submit' value=' Filter Modules ' class='button'></div></form><br\>\n";
  1003.  
  1004.     if ($mfilt eq 'ALL') {
  1005.         $moduleMerge->{'ALL'} = [ keys %{ $mALL } ];
  1006.     }
  1007.  
  1008.  
  1009.     $mList .= qq[ 
  1010. <table class='moduleList' width='100%' cellspacing=0 border=0>
  1011.  
  1012. ];
  1013.  
  1014.  
  1015.     # Build a hash mapping the module titles to the module names
  1016.     my $mname = {};
  1017.     foreach my $ename ( @{ $moduleMerge->{$mfilt} } ) {
  1018.         my $mod = $modules->{$mtype}->{$ename};
  1019.         $mname->{ $mod->Name } = $ename;
  1020.     }
  1021.  
  1022.     # Dump out all of the matching modules for this key, os, or arch
  1023.     foreach my $etitle (sort keys %{ $mname } ) {
  1024.         
  1025.         my $ename = $mname->{ $etitle };
  1026.         my $mod = $modules->{$mtype}->{$ename};
  1027.         my $icons;
  1028.         
  1029.         foreach ( KeysToIcons( @{ $mod->OS } ) ) {
  1030.             $icons  .= "<img src='/RESOURCE?ICON=". $_ ."' border=0 class='iconset' alt='".$_."'> ";
  1031.         }
  1032.         $mList .= "<tr>";
  1033.         $mList .= "<td class='moduleIcons' align='center'>$icons</td>";
  1034.         $mList .= "<td class='moduleName'><a href='/". uc($mtype) ."?MODE=SELECT&MODULE=".URLEncode($ename)."'>";
  1035.         $mList .= $mod->Name ."</a></td>";
  1036.         $mList .= "</tr>\n";
  1037.         
  1038.         $mList .= "<tr><td class='moduleSpacer' colspan=2></tr>\n";
  1039.         
  1040.     }
  1041.     
  1042.     $mList .= qq[
  1043. </table>
  1044. ];
  1045.  
  1046.     return $mList;
  1047. }
  1048.  
  1049. sub ModuleInfo {
  1050.     my $module = shift;
  1051.     my $res;
  1052.     
  1053.     my $desc = XSS_Filter($module->Description);
  1054.     
  1055.     my ($rev)   = $module->Version() =~ m/\$Revisio.:\s+([^\$]+)/; 
  1056.     $res .= "<table align='center' cellpadding=6 border=0 cellspacing=0 width='95%'>\n";
  1057.     
  1058.     my $class;
  1059.     if ($module->can('ModuleClass') && $module->ModuleClass) {
  1060.         $class = ' ('. $module->ModuleClass .')';
  1061.     }
  1062.         
  1063.     $res .= "<tr><td align='right' width=80 class='textBold'>Name:</td>";
  1064.     $res .= "<td class='textNormal'>" . $module->SelfEndName() . " v$rev $class</td></tr>\n";
  1065.  
  1066.     my @authors = @{$module->Authors()};
  1067.     my $author = shift(@authors);
  1068.     $author =~ s/</</g;
  1069.     $author =~ s/>/>/g;
  1070.     $res .= "<tr><td align='right' width=80 class='textBold'>Authors:</td>";
  1071.     $res .= "<td class='textNormal'>$author</td></tr>\n";
  1072.     
  1073.     foreach my $author (@authors) {
  1074.         $author =~ s/</</g;
  1075.         $author =~ s/>/>/g;
  1076.         $res .= "<tr><td align='right' width=80> </td><td class='textNormal'>$author</td></tr>\n";
  1077.     }
  1078.     
  1079.     if ($module->can('Multistage') && $module->Multistage) {
  1080.         $res .= "<tr><td align='right' width=80 class='textBold'> Multistage:</td>";
  1081.         $res .= "<td class='textNormal'>Yes</td></tr>\n";
  1082.     }
  1083.     
  1084.     if ($module->can('Size') && $module->Size) {
  1085.         $res .= "<tr><td align='right' width=80 class='textBold'> Size:</td>";
  1086.         $res .= "<td class='textNormal'>".$module->Size." bytes</td></tr>\n";
  1087.     }    
  1088.  
  1089.     if ($module->can('DisclosureDate') && $module->DisclosureDate) {
  1090.         $res .= "<tr><td align='right' width=80 class='textBold'> Disclosure:</td>";
  1091.         $res .= "<td class='textNormal'>".$module->DisclosureDate."</td></tr>\n";
  1092.     }        
  1093.     
  1094.     if (scalar( @{ $module->Arch } )) {
  1095.         $res .= "<tr><td align='right' width=80 class='textBold'>Arch:</td>";
  1096.         $res .= "<td class='textNormal'>". join(", ", @{ $module->Arch }) ."</td></tr>\n";
  1097.     }
  1098.         
  1099.     if (scalar( @{ $module->OS } )) {
  1100.         
  1101.         $res .= "<tr><td align='right' width=80 class='textBold'>OS:</td>";
  1102.         $res .= "<td class='textNormal'>". join(", ", @{ $module->OS }) ."</td></tr>\n";
  1103.         
  1104.     }
  1105.  
  1106.     $res .= "<tr><td colspan=2 class='textNormal'>";
  1107.     $res .= "<br>$desc<br><br>";
  1108.  
  1109.     foreach my $ref (@{$module->RefLinks}) { $res .= " -  <a href='$ref' target='_blank'>$ref</a><br>\n" }
  1110.     
  1111.     $res .= "<br></td></tr></table>\n";
  1112.     return $res;
  1113. }
  1114.  
  1115. sub PayloadEncoders {
  1116.     my $payloadArch    = shift;
  1117.     my $payloadOS    = shift;
  1118.     my %res;
  1119.     
  1120.     foreach my $encoderName (keys %{ $encodersIndex }) {
  1121.         my $encoder        = $encodersIndex->{$encoderName};        
  1122.         my $encoderArch    = $encoder->Arch;
  1123.         my $encoderOS    = $encoder->OS;
  1124.  
  1125.         next if ! $ui->ListCheck($payloadArch,    $encoderArch);
  1126.         next if ! $ui->ListCheck($payloadOS,    $encoderOS);
  1127.         $res{ $encoderName } = $encoder;
  1128.     }
  1129.     return %res;
  1130. }
  1131.  
  1132. sub PayloadNops {
  1133.     my $payloadArch    = shift;
  1134.     my $payloadOS    = shift;
  1135.     my %res;
  1136.     
  1137.     foreach my $nopName (keys %{ $nopsIndex }) {
  1138.         my $nop        = $nopsIndex->{$nopName};        
  1139.         my $nopArch    = $nop->Arch;
  1140.         my $nopOS    = $nop->OS;
  1141.  
  1142.         next if ! $ui->ListCheck($payloadArch,    $nopArch);
  1143.         next if ! $ui->ListCheck($payloadOS,    $nopOS);
  1144.         $res{ $nopName } = $nop;
  1145.     }
  1146.     return %res;
  1147. }
  1148.  
  1149. sub PayloadOptions
  1150. {
  1151.     my ($state) = @_;
  1152.     my $module = $state->{'MODULE'};
  1153.     my $res; 
  1154.  
  1155.     if (! exists($payloads->{$module})) {
  1156.         return "<div class='textBold'>Invalid Module</div>";
  1157.     }
  1158.  
  1159.     my $p = $payloads->{$module};
  1160.     
  1161.     $res .= ModuleInfo($p);     
  1162.     
  1163.     $res .= "<form action='$burl' method='GET'>\n";  
  1164.     $res .= "<table align='center' padding=4 border=0 cellspacing=0 width='95%'>\n"; 
  1165.     
  1166.     foreach (keys(%{$state})) {
  1167.         next if lc($_) eq 'client';
  1168.         if ($_ ne "MODE") {
  1169.             $res .= "<input type='hidden' name='".XSS_Filter($_)."' value='" . XSS_Filter($state->{$_}) . "'>\n";
  1170.         } else {
  1171.             $res .= "<input type='hidden' name='MODE' value='GENERATE'>\n";
  1172.         }
  1173.     }
  1174.   
  1175.     my $popts =  $p->UserOpts();
  1176.  
  1177.     foreach my $popt (sort(keys(%{$popts}))) {
  1178.  
  1179.         my $dflt = $popts->{$popt}->[3];
  1180.         my $reqd = $popts->{$popt}->[0] ? "Required" : "Optional";
  1181.         my $colc = $popts->{$popt}->[0] ? "textBold" : "textBoldDark";
  1182.         
  1183.         $dflt = Pex::Utils::SourceIP() if $popt eq "LHOST";
  1184.         
  1185.         $res .= "<tr><td class='$colc'>$popt</td>".
  1186.                 "<td class='$colc'>$reqd</td>".
  1187.                 "<td class='$colc'>". $popts->{$popt}->[1] ."</td>".
  1188.                 "<td class='textNormal'><input type='text' name='OPT_$popt' value='$dflt'></td>".
  1189.                 "<td class='textNormal'>".$popts->{$popt}->[2]."</td></tr>\n"; 
  1190.     }
  1191.     
  1192.     $res .= "<tr><td colspan=6> </td></tr>\n";
  1193.     
  1194.     # Display encoding options only when an arch is set    
  1195.     if (scalar( @{ $p->Arch } )) {
  1196.         $res .= "<tr><td colspan=6 class='textBold'>";
  1197.         $res .= "Max Size: ";
  1198.         $res .= "<input type='text' size=10 name='MaxSize' value=''>";
  1199.         $res .= "</td></tr>\n";
  1200.         
  1201.         $res .= "<tr><td colspan=6> </td></tr>\n";
  1202.         
  1203.         $res .= "<tr><td colspan=6 class='textBold'>";
  1204.         $res .= "Restricted Characters (format: 0x00 0x01)<br\> ";
  1205.         $res .= "<input type='text' size=45 name='BadChars' value='0x00 '>";
  1206.         $res .= "</td></tr>\n";
  1207.  
  1208.         $res .= "<tr><td colspan=6> </td></tr>\n";
  1209.  
  1210.         my %encoderList = PayloadEncoders($p->Arch, $p->OS);
  1211.         
  1212.         $res .= "<tr><td colspan=6 class='textBold'>";
  1213.         $res .= "Selected Encoder:<br\> ";
  1214.         $res .= "<select name='ENCODER' size=1>\n";
  1215.         $res .= "<option value='default'> Default Encoder\n";
  1216.         foreach my $encoderName (keys %encoderList) {
  1217.             $res .= "<option> $encoderName\n";
  1218.         }
  1219.         $res .= "</select>\n";
  1220.         $res .= "</td></tr>\n";        
  1221.     }
  1222.     
  1223.     $res .= "<tr><td colspan=6> </td></tr>\n";
  1224.     $res .= "<tr><td colspan=6><input type='submit' name='ACTION' value='Generate Payload' class='button'></td></tr>\n";
  1225.     $res .= "</form>\n";
  1226.     $res .= "</table>\n";  
  1227.     return $res;
  1228. }
  1229.  
  1230.  
  1231.  
  1232. sub PayloadGenerate
  1233. {
  1234.     my ($state) = @_;
  1235.     my $module = $state->{'MODULE'};
  1236.     my $res; 
  1237.  
  1238.     if (! exists($payloads->{$module})) {
  1239.         return "<div class='textBold'>Invalid Module</div>";
  1240.     }
  1241.  
  1242.     my $p = $payloads->{$module};
  1243.     my $o = StateToOptions($state);
  1244.     
  1245.     my $optstr;
  1246.     foreach my $k (keys(%{ $o })) {
  1247.         $ui->SetTempEnv($k, $o->{$k});
  1248.         $optstr .= " $k=".$o->{$k};
  1249.     }
  1250.     
  1251.     my $badChars = CharsToBytes($state->{'BadChars'});
  1252.     my $maxSize  = $state->{'MaxSize'} || 65000;
  1253.     my $rawShell = $p->Build();
  1254.  
  1255.     
  1256.     my ($payloadArch)    = $p->Arch;
  1257.     my ($payloadOS)        = $p->OS;
  1258.  
  1259.     my $finalEncoder;
  1260.     my $encodedPayload;
  1261.     
  1262.         
  1263.     if (! $badChars) {
  1264.         $finalEncoder = 'None';
  1265.         $encodedPayload = Msf::EncodedPayload->new($rawShell, $rawShell);
  1266.     }
  1267.     
  1268.     my %encoderList    = PayloadEncoders($payloadArch, $payloadOS);
  1269.     my $encoderOpt    = $state->{'ENCODER'};
  1270.     
  1271.     if (scalar(@{ $p->Arch }) && $encoderOpt ne 'default' && ! exists($encoderList{$encoderOpt})) {
  1272.         return "<div class='textBold'>Invalid encoder specified!</div>";
  1273.     }
  1274.     
  1275.     # Shrink the list down to the single selected option
  1276.     if ($encoderOpt ne 'default') {
  1277.         %encoderList = ( $encoderOpt => $encoderList{ $encoderOpt } );
  1278.     }
  1279.     
  1280.     foreach my $encoderName (keys %encoderList) {
  1281.         next if ! $badChars;
  1282.         
  1283.         my $encoder            = $encoderList{$encoderName};
  1284.         my $encodedShell    = $encoder->Encode($rawShell, $badChars);
  1285.  
  1286.         next if ! $encodedShell;
  1287.  
  1288.         if ($encoder->IsError) {
  1289.             $encoder->ClearError;
  1290.             next;
  1291.         }
  1292.  
  1293.         next if Pex::Text::BadCharCheck($badChars, $encodedShell);
  1294.         
  1295.         $encodedPayload = Msf::EncodedPayload->new($rawShell, $encodedShell);
  1296.  
  1297.         if (length($encodedPayload->Payload) > $maxSize) {
  1298.             undef($encodedPayload);
  1299.             next;
  1300.         }
  1301.         
  1302.         $finalEncoder = $encoder->SelfEndName;
  1303.         last;
  1304.     }
  1305.  
  1306.     if (! $encodedPayload) {
  1307.         $res .= "<div class='textBold'>No encoders succeeded :( </div>\n";
  1308.         return $res;
  1309.     }    
  1310.     
  1311.     my $sC = Pex::Text::BufferC($encodedPayload->Payload);
  1312.     my $sP = Pex::Text::BufferPerl($encodedPayload->Payload);
  1313.  
  1314.     if ($p->Multistage) {
  1315.         $res .= "<div class='textBold'>Warning: only the loading stage of multi-stage payloads will be displayed!</div>\n<br\>";    
  1316.     }
  1317.  
  1318.  
  1319.  
  1320.     $optstr =~ s/\<|\>//g;
  1321.     $optstr .= " Size=".length($encodedPayload->Payload);
  1322.     $optstr .= " Encoder=$finalEncoder";
  1323.     
  1324.     $res .= "<pre>\n";
  1325.     $res .= "<div class='shellcode'>";
  1326.     $res .= "/* $module - $optstr http://metasploit.com */\n";
  1327.     $res .= "unsigned char scode[] =\n$sC\n\n\n";
  1328.  
  1329.     $res .= "# $module - $optstr http://metasploit.com\n";
  1330.     $res .= "my \$shellcode =\n$sP\n\n\n";
  1331.  
  1332.     $res .= "</div></pre>\n";
  1333.     
  1334.     return $res;    
  1335. }
  1336.  
  1337.  
  1338. sub ExploitTarget
  1339. {
  1340.     my ($state) = @_;
  1341.     my $module = $state->{'MODULE'};
  1342.     my $res; 
  1343.     
  1344.     if (! exists($exploits->{$module})) {
  1345.         return "<div class='textBold'>Invalid Module</div>";
  1346.     }
  1347.     
  1348.     my $x = $exploits->{$module};
  1349.     
  1350.     $res .= ModuleInfo($x);
  1351.  
  1352.     # Display available targets
  1353.  
  1354.     if (scalar($x->TargetsList) ) {
  1355.         $res .= "<table align='align' cellpadding=2 border=0 cellspacing=0'>\n";
  1356.         $res .= "<tr><td class='textBold' align='left'>Select Target:</td><td> </td></tr>";
  1357.  
  1358.         my $tidx = 0;
  1359.         my $colc = ListColor();
  1360.         foreach my $k ( $x->TargetsList )
  1361.         {
  1362.             my $u = StateToURL('PAYLOAD', $state);
  1363.             my $default;
  1364.             
  1365.             if ($tidx == $x->DefaultTarget) {
  1366.                 $default = "(default)";
  1367.             }
  1368.             $colc = ListColor($colc);
  1369.             
  1370.             $res .= "<tr><td> </td><td align='left' class='textBold$colc'>$tidx - <a href='".$u."OPT_TARGET=$tidx'> $k $default </a></td></tr>\n";
  1371.             $tidx++;
  1372.         }
  1373.         $res .= "</table>\n";
  1374.     } else {
  1375.         $res .= ExploitPayload($state);
  1376.     }
  1377.     return $res;
  1378. }
  1379.  
  1380. sub ExploitPayload
  1381. {
  1382.     my ($state) = @_;
  1383.     my $module = $state->{'MODULE'};
  1384.     my $res; 
  1385.     
  1386.     if (! exists($exploits->{$module})) {
  1387.         return "<div class='textBold'>Invalid Module</div>";
  1388.     }
  1389.     
  1390.     my $x = $exploits->{$module};
  1391.  
  1392.     # Display available payloads
  1393.  
  1394.     my $matches = $ui->MatchPayloads($x, $payloads) if($x->Payload);
  1395.  
  1396.     if (defined($x->Payload) ) {
  1397.         $res .= "<p class='textBold'>Select Payload:<br\></p>\n";
  1398.         $res .= "<table align='center' cellpadding=2 border=0 cellspacing=0 width='95%'>\n";
  1399.         $res .= "<tr><td class='textBold' align='center'>Payload</td>";
  1400.         $res .= "    <td class='textBold' align='center'>Description</td></tr>\n";
  1401.         $res .= "<tr><td colspan=2><br\></td></tr>\n";
  1402.  
  1403.         my $colc = ListColor();                
  1404.         foreach my $k (sort(keys(%{ $matches })))
  1405.         {
  1406.             my $u = StateToURL('OPTIONS', $state);
  1407.             my $pname = $payloads->{$k}->Name();
  1408.             $colc = ListColor($colc);
  1409.             $res .= "<tr><td class='textNormal$colc'><a href='".$u."PAYLOAD=" . $k . "'>$k</a></td>";
  1410.             $res .= "<td class='textBold$colc'>" .$pname . "</td></tr>\n";
  1411.         }
  1412.         $res .= "</table>\n";
  1413.     } else {
  1414.         $res .= ExploitOptions($state);
  1415.     }
  1416.     return $res;
  1417. }
  1418.  
  1419. sub ExploitOptions
  1420. {
  1421.     my ($state) = @_;
  1422.     my $module = $state->{'MODULE'};
  1423.     my $res; 
  1424.     
  1425.     if (! exists($exploits->{$module})) {
  1426.         return "<div class='textBold'>Invalid Module</div>";
  1427.     }
  1428.  
  1429.     my $x = $exploits->{$module};
  1430.     my $p = $payloads->{$state->{'PAYLOAD'}};
  1431.  
  1432.     $res .= "<form action='$burl' method='GET'>\n";    
  1433.         
  1434.     if (defined($x->Payload) && ! $state->{"PAYLOAD"})
  1435.     {
  1436.         $res .=  "<div class='textBold'>Payload must be selected first!</div>\n";
  1437.         return $res;
  1438.     }
  1439.  
  1440.     foreach (keys(%{$state})) {
  1441.         next if lc($_) eq 'client';
  1442.         next if lc($_) eq 'parent';
  1443.         
  1444.         if ($_ ne "MODE") {
  1445.             $res .= "<input type='hidden' name='".XSS_Filter($_)."' value='" . XSS_Filter($state->{$_}) . "'>\n";
  1446.         } else {
  1447.             $res .= "<input type='hidden' name='MODE' value='EXPLOIT'>\n";
  1448.         }
  1449.     }
  1450.  
  1451.     $res .= "<table align='center' cellpadding=2 border=0 cellspacing=0 width='95%'>\n";
  1452.     
  1453.     my $mopts = $x->UserOpts;
  1454.     my $popts = defined($x->Payload) ? $p->UserOpts : {};
  1455.  
  1456.     # Standard exploit options
  1457.     foreach my $mopt (sort(keys(%{$mopts}))) {
  1458.         my $dflt = $mopts->{$mopt}->[3];
  1459.         my $reqd = $mopts->{$mopt}->[0] ? "Required" : "Optional";
  1460.         my $colc = $mopts->{$mopt}->[0] ? "textBold" : "textBoldDark";
  1461.         
  1462.         if (exists($x->AutoOpts->{$mopt})) {
  1463.             $dflt = $x->AutoOpts->{$mopt};
  1464.         }
  1465.         
  1466.         $res .= "<tr><td class='$colc'>$mopt</td>".
  1467.                 "<td class='$colc'>$reqd</td>".
  1468.                 "<td class='$colc'>". $mopts->{$mopt}->[1] ."</td>".
  1469.                 "<td class='textNormal'><input type='text' name='OPT_$mopt' value='$dflt'></td>".
  1470.                 "<td class='textNormal'>".$mopts->{$mopt}->[2]."</td></tr>\n";
  1471.     }
  1472.     
  1473.     # Standard payload options
  1474.     foreach my $popt (sort(keys(%{$popts}))) {
  1475.  
  1476.         my $dflt = $popts->{$popt}->[3];
  1477.         my $reqd = $popts->{$popt}->[0] ? "Required" : "Optional";
  1478.         my $colc = $popts->{$popt}->[0] ? "textBold" : "textBoldDark";
  1479.         
  1480.         $dflt = Pex::Utils::SourceIP() if $popt eq "LHOST";
  1481.  
  1482.          if (exists($x->AutoOpts->{$popt})) {
  1483.             $dflt = $x->AutoOpts->{$popt};
  1484.         }
  1485.                
  1486.         $res .= "<tr><td class='$colc'>$popt</td>".
  1487.                 "<td class='$colc'>$reqd</td>".
  1488.                 "<td class='$colc'>". $popts->{$popt}->[1] ."</td>".
  1489.                 "<td class='textNormal'><input type='text' name='OPT_$popt' value='$dflt'></td>".
  1490.                 "<td class='textNormal'>".$popts->{$popt}->[2]."</td></tr>\n"; 
  1491.     }
  1492.  
  1493.         
  1494.     if ($p && @{ $p->Arch } ) {
  1495.  
  1496.         $res .= "<tr><td colspan=5> </td></tr>\n";
  1497.         my %encoderList = PayloadEncoders($p->Arch, $p->OS);
  1498.  
  1499.         $res .= "<tr>\n";
  1500.         $res .= "<td colspan=3 class='textBold'>";
  1501.         $res .= "Preferred Encoder:<br\> ";
  1502.         $res .= "<select name='ENCODER' size=1>\n";
  1503.         $res .= "<option value='default'> Default Encoder\n";
  1504.         foreach my $encoderName (keys %encoderList) {
  1505.             $res .= "<option> $encoderName\n";
  1506.         }    
  1507.         $res .= "</select>\n";
  1508.         $res .= "</td>\n";    
  1509.  
  1510.  
  1511.         my %nopList = PayloadNops($p->Arch, $p->OS);
  1512.         $res .= "<td colspan=2 class='textBold'>";
  1513.         $res .= "Nop Generator:<br\> ";
  1514.         $res .= "<select name='NOP' size=1>\n";
  1515.         $res .= "<option value='default'> Default Generator\n";
  1516.         foreach my $nopName (keys %nopList) {
  1517.             $res .= "<option> $nopName\n";
  1518.         }    
  1519.         $res .= "</select>\n";
  1520.         $res .= "</td>";
  1521.         $res .= "</tr>\n";        
  1522.     }
  1523.     
  1524.     $res .= "<tr><td colspan=5> </td></tr>\n";
  1525.             
  1526.     $res .= "<tr>";
  1527.     $res .= "<td colspan=3 align='right'> <input type='submit' name='ExploitAction' value='-Check-' class='button'> </td>";
  1528.     $res .= "<td colspan=2 align='left'> <input type='submit' name='ExploitAction' value='-Exploit-' class='button'> </td>";
  1529.     $res .= "</tr>\n";
  1530.     
  1531.  
  1532.     # Advanced option processing    
  1533.     my $mopts = $x->Advanced();
  1534.     my $popts = defined($x->Payload) ? $p->Advanced() : {};
  1535.  
  1536.  
  1537.     if ( scalar(keys %{ $mopts} ) || scalar(keys %{ $popts} ) ) {
  1538.         $res .= "<tr><td colspan=5> </td></tr>\n";
  1539.         $res .= "<tr><td colspan=5> </td></tr>\n";
  1540.         $res .= "<tr><td colspan=5 class='textBold' align='left'>Advanced Module Options</td></tr>\n";
  1541.     }
  1542.     
  1543.     # Advanced exploit options    
  1544.     foreach my $mopt (sort(keys(%{$mopts}))) {
  1545.         my $dflt = $mopts->{$mopt}->[0];
  1546.         my $colc = "textBoldDark";
  1547.         
  1548.         if (exists($x->AutoOpts->{$mopt})) {
  1549.             $dflt = $x->AutoOpts->{$mopt};
  1550.         }
  1551.         
  1552.         $res .= "<tr><td colspan=5> </td></tr>\n";
  1553.         $res .= "<tr>".
  1554.                 "<td class='textBoldDark'>* $mopt</td>".
  1555.                 "<td class='textBoldDark'>Optional</td>".
  1556.                 "<td class='textBoldDark'>DATA</td>".
  1557.                 "<td class='textNormal'><input type='text' name='OPT_$mopt' value='$dflt'></td>".
  1558.                 "<td class='textNormal'>Advanced exploit option</td>".
  1559.                 "</tr>".
  1560.                 "<tr>".
  1561.                 "<td class='textNormal' colspan=5>   ".$mopts->{$mopt}->[1]."</td></tr>\n";
  1562.     }
  1563.     
  1564.     # Advanced payload options    
  1565.     foreach my $popt (sort(keys(%{$popts}))) {
  1566.         my $dflt = $popts->{$popt}->[0];
  1567.         my $colc = "textBoldDark";
  1568.         
  1569.         if (exists($x->AutoOpts->{$popt})) {
  1570.             $dflt = $x->AutoOpts->{$popt};
  1571.         }
  1572.         
  1573.         $res .= "<tr><td colspan=5> </td></tr>\n";
  1574.         $res .= "<tr>".
  1575.                 "<td class='textBoldDark'>* $popt</td>".
  1576.                 "<td class='textBoldDark'>Optional</td>".
  1577.                 "<td class='textBoldDark'>DATA</td>".
  1578.                 "<td class='textNormal'><input type='text' name='OPT_$popt' value='$dflt'></td>".
  1579.                 "<td class='textNormal'>Advanced payload option</td>".
  1580.                 "</tr>".
  1581.                 "<tr>".
  1582.                 "<td class='textNormal' colspan=5>   ".$popts->{$popt}->[1]."</td></tr>\n";
  1583.     }
  1584.     
  1585.     $res .= "</table>\n";
  1586.     $res .= "</form>\n";    
  1587.     return $res;
  1588. }
  1589.  
  1590. sub ExploitExec
  1591. {
  1592.     my ($state) = @_;
  1593.     my $module = $state->{'MODULE'};
  1594.     my $res; 
  1595.     my $exploit = $exploits->{$module};
  1596.     
  1597.     if (! $exploit) {
  1598.         return "<div class='textBold'>Invalid Module</div>";
  1599.     }
  1600.  
  1601.     my $o = StateToOptions($state);
  1602.     foreach my $k (keys(%{ $o })) {
  1603.         $ui->SetTempEnv($k, $o->{$k});
  1604.     }
  1605.     
  1606.     $ui->SetTempEnv('PAYLOAD', $state->{'PAYLOAD'});
  1607.     
  1608.     my $validPayloads = $ui->MatchPayloads($exploit, $payloads) if($exploit->Payload);
  1609.  
  1610.     my $payloadName = $ui->GetEnv('PAYLOAD');
  1611.     my $payload = $validPayloads->{$payloadName};
  1612.  
  1613.     if ($state->{'NOP'} && $state->{'NOP'} ne 'default') {
  1614.         $ui->SetTempEnv('Nop', $state->{'NOP'});
  1615.     }
  1616.     
  1617.     if ($state->{'ENCODER'} && $state->{'ENCODER'} ne 'default') {
  1618.         $ui->SetTempEnv('Encoder', $state->{'ENCODER'});
  1619.     }
  1620.  
  1621.     # Mmmmm, candy
  1622.     $ui->SetTempEnv('_Exploits', $exploits);
  1623.     $ui->SetTempEnv('_Payloads', $payloads);
  1624.     $ui->SetTempEnv('_Exploit', $exploit);
  1625.     $ui->SetTempEnv('_PayloadName', $payloadName);
  1626.     $ui->SetTempEnv('_Payload', $payload);
  1627.     $ui->SetTempEnv('_ValidPayloads', $validPayloads);
  1628.     $ui->SetTempEnv('_UI', $ui);
  1629.    
  1630.     
  1631.     if ($state->{'ExploitAction'} eq '-Check-') {
  1632.         $res .= "\n<form action='$burl' method='GET'>\n";
  1633.         foreach (keys(%{$state})) {
  1634.             if ($_ ne "MODE")  {
  1635.                 $res .= "<input type='hidden' name='".XSS_Filter($_)."' value='" . XSS_Filter($state->{$_}) . "'>\n";
  1636.             } else {
  1637.                 $res .= "<input type='hidden' name='MODE' value='EXPLOIT'>\n";
  1638.             }
  1639.         }
  1640.  
  1641.         $res .= "<input type='submit' name='ExploitAction' value='Launch Exploit' class='button'>\n";
  1642.         $res .= "</form>\n";
  1643.         $res .= "<hr><br><br>\n";
  1644.  
  1645.         if ($ui->GetTempEnv('_Defanged')) {
  1646.                 $res .= "<br><div class='textBold'>This server has been started in 'Defanged' mode. ";
  1647.                 $res .= "Check and Exploit options are not available...</div>\n";
  1648.                 return $res;
  1649.         } 
  1650.         else {
  1651.             $res .= "<br><div class='textBold'>Check Results: ";
  1652.             $res .= (($ui->Check) ? "Vulnerable" : "Not Vulnerable") . "</div><br>\n";
  1653.             $res .= "<br>". join("<br>\n", @{$ui->DumpLines}) . "<br>\n";
  1654.         }
  1655.         
  1656.         return $res;
  1657.     }
  1658.     $res .= "<table align='center' padding=4 border=0 cellspacing=0 width='95%'>\n";
  1659.     
  1660.     if (defined($exploit->Payload) && defined($payloadName) && ! defined($payload) ) {
  1661.         $res .=  "<tr><td class='textBold'>Payload must be selected first!</td></tr></table>\n";
  1662.         return $res;
  1663.     }
  1664.     
  1665.     if ($ui->GetTempEnv('_Defanged')) {
  1666.             $res .= "<br><div class='textBold'>This server has been started in 'Defanged' mode. ";
  1667.             $res .= "Check and Exploit options are not available...</div>\n";
  1668.             return $res;
  1669.     } 
  1670.   
  1671.     # We hijack the socket from the web service
  1672.     my $bout = $state->{'client'};
  1673.     my $pout = $state->{'parent'};
  1674.         
  1675.     # Use chunked transfer mode to return partial responses
  1676.     my $out = "HTTP/1.1 200 OK\r\n".
  1677.               "Connection: close\r\n".
  1678.               "Date: ". HTTPDate()."\r\n".
  1679.               "Content-Type: text/html\r\n".
  1680.               "Transfer-Encoding: chunked\r\n\r\n";
  1681.     
  1682.     $bout->Send($out);
  1683.     
  1684.     $out = HTML_Header().
  1685.            "<div class='moduleOutput'>\n".
  1686.            "<b>Processing exploit request (".$exploit->Name.")...</b><br>\n".
  1687.            "<b>Using payload: " . XSS_Filter($payloadName) . "</div><br>\n".
  1688. qq[           
  1689.         <br>
  1690.         </td>
  1691.     </tr>
  1692. </table></td></tr></table>
  1693. <br>
  1694. ];
  1695.  
  1696.  
  1697.     # Close out the main table and prepare for incremental output
  1698.     $out .=
  1699.         "<br\><hr size=1 width='80%'>".
  1700.         "<div align='center' class='navHead'> Exploit Output </div>\n".
  1701.         "<hr size=1 width='80%'><br\>".    
  1702.         "<div align='left' class='moduleOutput'>\n".
  1703.         "<blockquote><blockquote>\n\n";
  1704.     $bout->Send(sprintf("%x\r\n%s\r\n", length($out), $out));
  1705.     
  1706.     
  1707.     # Ask the parent for a session ID
  1708.     $pout->printflush("SESSION\n");
  1709.     my $raw = $pout->getline;
  1710.     
  1711.     
  1712.     if (! $raw || $raw !~ /SID ([0-9]{0,16})/ ) {
  1713.         $out = "[*] <div class='textBold'>msfweb: unable to obtain session...</div>";
  1714.         $bout->Send(sprintf("%x\r\n%s\r\n", length($out), $out));
  1715.         exit(0);
  1716.     }
  1717.     
  1718.     my ($sid) = $raw =~ m/SID ([0-9]{0,16})/g;
  1719.  
  1720.     
  1721.     # Configure stdio for the child process
  1722.     my ($einp, $eout, $einp_sock, $eout_sock);
  1723.     
  1724.     socketpair($einp_sock, $eout_sock, AF_UNIX, SOCK_STREAM, PF_UNSPEC);
  1725.     
  1726.     my $einp = IO::Handle->new_from_fd(fileno($einp_sock), "a+");
  1727.     my $eout = IO::Handle->new_from_fd(fileno($eout_sock), "a+");
  1728.     
  1729.     # Configure the environment...
  1730.     $ui->SetTempEnv('_PipeInput',  $einp);
  1731.     $ui->SetTempEnv('_PipeOutput', $einp);
  1732.     $ui->SetTempEnv('_GhettoIPC',  $pout);
  1733.     $ui->SetTempEnv('_SessionID',  $sid);
  1734.     $ui->SetTempEnv('_BrowserSocket', $bout);    
  1735.     
  1736.     # Save the parent pid
  1737.     my $top = $$;
  1738.     
  1739.     # Save off some information about this session
  1740.     my %sess =
  1741.     (
  1742.         'module'    => $module,
  1743.         'client'    => $bout->PeerAddr,
  1744.         'target'    => $ui->GetEnv('RHOST') || 'unknown',
  1745.         'start'        => time(),
  1746.         'payload'    => $ui->GetEnv('PAYLOAD') || 'unknown',
  1747.     );
  1748.     
  1749.     
  1750.     # Now things get interesting :-)
  1751.     my $epid = fork();
  1752.     
  1753.     # The main process will keep our IPC open as long as we stay alive
  1754.     if ($epid) {
  1755.         
  1756.         my $cache_file = $ui->GetEnv('_CachePath').sprintf("cache%.8x.dat", $sid);
  1757.         
  1758.         # Wait for the go-ahead message from the parent
  1759.         my $ok = $pout->getline;
  1760.         exit if ! $ok;
  1761.         chomp($ok);
  1762.  
  1763.         if ($ok eq 'SHUTDOWN') {
  1764.             $eout->close;
  1765.             $pout->close;
  1766.             exit(0);
  1767.         }
  1768.         
  1769.         if ($ok ne 'SHELL') {
  1770.             $eout->close;
  1771.             $pout->close;
  1772.             exit(0);
  1773.         }
  1774.         
  1775.         $SIG{'INT'} = $SIG{'TERM'} = sub 
  1776.         {
  1777.             # print STDERR "*** Shutting down processes for session $sid...\n";
  1778.             $eout->printflush("!^! MSF_SHUTDOWN\n");
  1779.             $eout->sync;
  1780.             $eout->close;
  1781.             $pout->close;
  1782.             kill KILL => $epid;
  1783.             exit(0);        
  1784.         };
  1785.         
  1786.         my $info = IPCHashToData(%sess);
  1787.         $pout->printflush("INFO $sid $info\n");
  1788.         
  1789.         # Remove the cache file if it already exists
  1790.         unlink($cache_file);
  1791.  
  1792.         # Open the file again for real this time
  1793.         if (! open (CACHE, '>', $cache_file)) {
  1794.             print STDERR "Could not create cache file: ($cache_file) $!\n";
  1795.             $eout->close;
  1796.             $pout->close;
  1797.             exit(0);        
  1798.         }
  1799.         
  1800.         # Set binary mode in case we need it
  1801.         binmode(CACHE);    
  1802.  
  1803.         my $cache = IO::Handle->new_from_fd(fileno(CACHE), 'w');
  1804.         
  1805.         if (not defined($cache)) {
  1806.             print STDERR "Could not open cache file descriptor: ($cache_file) $!\n";
  1807.             $eout->close;
  1808.             $pout->close;
  1809.             exit(0);
  1810.         }
  1811.  
  1812.         $cache->blocking(0);
  1813.         $cache->autoflush(1);
  1814.         
  1815.         my $keepRunning = 1;
  1816.         
  1817.         while ($keepRunning) {
  1818.             my $sel = IO::Select->new();
  1819.             
  1820.             foreach ($eout, $pout) {
  1821.                 $_->autoflush(1);
  1822.                 $_->blocking(0);
  1823.                 $sel->add($_);
  1824.             }
  1825.  
  1826.             my @rdy = $sel->can_read(0.25);
  1827.             foreach my $fd (@rdy) {
  1828.  
  1829.                 # Output from the shell
  1830.                 if ($fd eq $eout) {
  1831.                     my ($data, $buff);
  1832.                     while ($eout->read($buff, 1024)) { $data .= $buff }
  1833.                     $cache->printflush(XSS_Filter($data));
  1834.                     $cache->sync;
  1835.                 }
  1836.                 
  1837.                 # Request from the server
  1838.                 if ($fd eq $pout) {
  1839.                     my $data = $pout->getline;
  1840.                     chomp ($data);
  1841.                 
  1842.                     if ($data eq 'SHUTDOWN') {
  1843.                         $keepRunning = 0;
  1844.                         next;
  1845.                     }
  1846.                     
  1847.                     # Command request from a client
  1848.                     if ($data =~ m/DATA\s+(.*)/) {
  1849.                         my $bytes = pack('H*', $1);
  1850.                         $eout->printflush($bytes);
  1851.                         
  1852.                         # write command to cache file
  1853.                         $bytes = XSS_Filter($bytes);
  1854.                         my $out = "\n<div class='textBold'>>> $bytes</div>\n";
  1855.                         $cache->printflush($out);
  1856.                         $cache->sync;
  1857.                         next;
  1858.                     }
  1859.                     
  1860.                     # Command request from a client
  1861.                     if ($data =~ m/CMD\s+(.*)/) {
  1862.                         my $cmd = pack('H*', $1);
  1863.                         my $out = "<div class='textBold'>>> ";
  1864.  
  1865.                         # Interrupt via magic command string :(
  1866.                         if ($cmd eq 'INT') {
  1867.                             $out .= "Session interrupt request...";
  1868.                             # $eout->printflush();
  1869.                             # $eout->printflush("!^! MSF_INTERRUPT\n");
  1870.                             kill INT => $epid;
  1871.                         }
  1872.                         
  1873.                         # Shutdown
  1874.                         if ($cmd eq 'DIE') {
  1875.                             $out .= "Session kill request...";
  1876.                             $keepRunning = 0;
  1877.                         }
  1878.                             
  1879.                         $out .= "</div>\n";
  1880.                         
  1881.                         $cache->printflush($out);
  1882.                         $cache->sync;
  1883.                         next;
  1884.                     }
  1885.                 }
  1886.             }
  1887.         }
  1888.         
  1889.         $cache->printflush("<div class='textBold'>>> Session is shutting down...</div>\n");
  1890.         $cache->sync;
  1891.         
  1892.         # Call the signal handler subroutine created above
  1893.         kill INT => $$;
  1894.         exit(0);
  1895.     }
  1896.     
  1897.     # Feel the magic o_0
  1898.     $ui->Exploit();
  1899.     
  1900.     if (! $ui->GetTempEnv('_ShellServer')) {
  1901.         $pout->printflush("SHUTDOWN $sid\n");
  1902.     }    
  1903.  
  1904.     exit(0);
  1905. }
  1906.  
  1907.  
  1908. # Primitive HTTP request parser
  1909. sub HTTPRequest {
  1910.     my $self    = shift;
  1911.     my $cli        = shift;
  1912.     my $opt        = shift;
  1913.     
  1914.     my $timeout    = exists($opt->{'Timeout'}) ? $opt->{'Timeout'} : 5;
  1915.     my $raw;
  1916.         
  1917.     my ($meth, $uri, $path, $query);
  1918.     my %headers;
  1919.     my %params;
  1920.     my @lines;
  1921.     my $linec = 0;
  1922.  
  1923.     # Read one line at a time until we hit the header separator
  1924.     # Defend against cheesy denial of service attacks...
  1925.         
  1926.     while ($raw ne "\r\n")
  1927.     {
  1928.         $raw = $cli->RecvLine($timeout);
  1929.         
  1930.         if (! $raw) {
  1931.             return { 'invalid' => 1 };
  1932.         }
  1933.         
  1934.         if (length($raw) > 65535) {
  1935.             return { 'oversized' => 1 };
  1936.         }
  1937.         
  1938.         if (scalar(@lines) > 100) {
  1939.             return {'oversized' => 1 };
  1940.         }
  1941.  
  1942.         push @lines, $raw;
  1943.     }
  1944.  
  1945.     my $rmeth    = shift(@lines);
  1946.         
  1947.     # Parse the request method and URI
  1948.     if ($rmeth =~ m/^([^\s]+)\s+([^\s]+)\s+/) {
  1949.         $meth    = lc($1);
  1950.         $uri    = $2;
  1951.     } 
  1952.     else { return {'invalid' => 1 };  }
  1953.     
  1954.     # Read the HTTP request headers
  1955.     foreach my $line (@lines) {
  1956.         $line =~ s/\r|\n//g;
  1957.         last if $line eq '';
  1958.         if ($line =~ m/^([^:]+):(\s+|)(.*)$/) {
  1959.             $headers{lc($1)} = $3;    
  1960.         }
  1961.     }
  1962.  
  1963.     # Convert URI encoding to hex encoding
  1964.     $uri =~ s/\+/%20/g;
  1965.         
  1966.     # Split out the path from the query string
  1967.     if ($uri =~ m/^([^\?]+)(\?(.*)|)$/) {
  1968.         $path    = $1;
  1969.         $query    = $3;
  1970.     }
  1971.     
  1972.     # Convert hex encoding to plain text
  1973.     $path =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  1974.     
  1975.     # Remove some garbage from the request
  1976.     $path =~ s/\x00|\x0a|\x0d|\<|\>|\s+$//g;
  1977.     
  1978.     # Remove parent paths and other bad joojoo
  1979.     $path =~ s/\/\.\.\/|\/\.\/|\\//g;
  1980.     
  1981.     # Convert multiple forward slashes to a single
  1982.     $path =~ s/\/+/\//g;
  1983.  
  1984.     # Break the individual variables into chunks
  1985.     my @chunks = split(/&/, $query);
  1986.     
  1987.     # Process the chunks and place into %params
  1988.     foreach my $chunk (@chunks) {
  1989.         my ($var, $val) = split(/=/, $chunk);
  1990.         $val =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  1991.         $params{$var} = $val;
  1992.  
  1993.         # ignore empty values
  1994.         $val =~ s/^\s+|\s+$//g;
  1995.         
  1996.         # strip out some hostile chars
  1997.         $val =~ s/\x00|\x0a|\x0d//g;
  1998.         
  1999.         # avoid cheesy xss attacks
  2000.         $val = XSS_Filter($val);      
  2001.         
  2002.         if (! length($val)) { delete($params{$var}) }
  2003.     }
  2004.     
  2005.     # Create a nice big hash of the request
  2006.     my $res  =
  2007.     {
  2008.         'method'    => $meth,
  2009.         'headers'    => \%headers,
  2010.         'params'    => \%params,
  2011.         'path'        => $path,
  2012.     };
  2013.  
  2014.     # Process the URL
  2015.     ($res->{'base'}) = $path =~ m/^\/([^\?]+)/;
  2016.     if (! $res->{'base'}) {
  2017.         $res->{'base'} = 'EXPLOITS';
  2018.     }
  2019.  
  2020.     # Default to main mode
  2021.     if (! $res->{'params'}->{'MODE'}) {
  2022.         $res->{'params'}->{'MODE'} = 'MAIN';
  2023.     }
  2024.     
  2025.     
  2026.     # Cache resource requests...
  2027.     if ( $res->{'base'} eq 'RESOURCE') {
  2028.         
  2029.         my $url = exists($params{'ID'}) ? $params{'ID'} : $params{'ICON'};
  2030.         
  2031.         # If they requested more than 100 different resources, cache block them
  2032.         # Checks above limit any given request to 65K anyways...
  2033.         
  2034.         if (scalar( keys %{ $cache_hosts{$cli->PeerAddr} }) > 100) {
  2035.             delete($cache_hosts{$cli->PeerAddr});
  2036.             $cache_hosts{$cli->PeerAddr}->{'_blocked_'}++;
  2037.         }
  2038.         
  2039.         # Clear the cache and return undef for cache attackers
  2040.         if ($cache_hosts{$cli->PeerAddr}->{'_blocked_'}) {
  2041.             $res->{'cache_block'}++;
  2042.             return $res;
  2043.         }
  2044.         
  2045.         if (    $url &&
  2046.                 $res->{'headers'}->{'if-modified-since'} &&
  2047.                 $cache_hosts{ $cli->PeerAddr }->{$url}    ) {
  2048.  
  2049.             $cli->Send(HTTPResponse(304, 'Probably cached...', 'text/html'));
  2050.             $res->{'cached'}++;
  2051.         }
  2052.         else {
  2053.             $cache_hosts{ $cli->PeerAddr }->{$url} = time();
  2054.         }
  2055.     }
  2056.     
  2057.     return $res;
  2058. }
  2059.  
  2060. sub HTTPResponse {
  2061.     my $code = @_ ? shift() : 403;
  2062.     my $body = @_ ? shift() : '';
  2063.     my $type = @_ ? shift() : 'text/html';
  2064.     my $data;
  2065.     
  2066.     $data = "HTTP/1.1 $code\r\n".
  2067.             "Connection: close\r\n".
  2068.             "Date: ". HTTPDate() ."\r\n".
  2069.             "Cache-Control: private\r\n".
  2070.             "Last-Modified: $cache_start\r\n".
  2071.             "Content-Length: ".length($body)."\r\n".
  2072.             "Content-Type: $type\r\n".
  2073.             "\r\n". $body;
  2074.  
  2075.     return $data;
  2076. }
  2077.  
  2078. sub HTTPDate {
  2079.     my $stime = shift() || [ gmtime() ];
  2080.     return strftime("%a, %e %b %Y %H:%M:%S GMT", @{ $stime });
  2081. }
  2082.  
  2083. sub CharsToBytes {
  2084.     my $chars = shift;
  2085.     my $badChars;
  2086.     foreach my $hc (split(/\s+/, $chars)) {
  2087.         if ($hc =~ m/^0x(.|..)/) {
  2088.             $badChars .= chr(hex($hc));
  2089.         } else {
  2090.             # it isn't hex char... maybe just plain char?
  2091.             foreach (split(//, $hc)) {
  2092.                 $badChars .= $_;
  2093.             }
  2094.         }
  2095.     }
  2096.     return $badChars;
  2097. }
  2098.  
  2099. # XXX - not complete
  2100. sub XSS_Filter {
  2101.     my $data = shift;
  2102.     $data =~ s/\&/\&/g;
  2103.     $data =~ s/\</\</g;
  2104.     $data =~ s/\>/\>/g;
  2105.     return $data;
  2106. }
  2107.  
  2108. sub IPCDataToHash {
  2109.     my $data = shift;
  2110.     my %hash;
  2111.     
  2112.     foreach (split(/,/, $data)) {
  2113.         my ($var, $val) = split(/\=/, $_);
  2114.         next if ! $var;
  2115.         next if ! $val;
  2116.         $hash{$var} = pack("H*", $val);
  2117.     }
  2118.     return %hash;
  2119. }
  2120.  
  2121. sub IPCHashToData {
  2122.     my %hash = @_;
  2123.     my $data;
  2124.     foreach (keys %hash) {
  2125.         $data .= $_."=".unpack("H*", $hash{$_}).",";
  2126.     }
  2127.     return $data;
  2128. }
  2129.  
  2130. sub ListColor {
  2131.     my $style = shift;
  2132.     return ($style eq 'ColorA') ? 'ColorB' : 'ColorA';
  2133. }
  2134.  
  2135. sub LoadAllModules {
  2136.     $exploitsIndex    = $ui->LoadExploits;
  2137.     $payloadsIndex    = $ui->LoadPayloads;
  2138.     $encodersIndex    = $ui->LoadEncoders;
  2139.     $nopsIndex        = $ui->LoadNops;
  2140.  
  2141.     $moduleTypes    = {};
  2142.     $moduleKeys        = {};
  2143.     $moduleOS        = {};
  2144.     $moduleArch        = {};
  2145.     $modules        = {};
  2146.  
  2147.     
  2148.     foreach my $key (keys(%{$exploitsIndex})) {
  2149.         my $exploit = $exploitsIndex->{$key};
  2150.         
  2151.         $exploits->{$exploit->SelfEndName} = $exploit;
  2152.         $modules->{'exploits'}->{$exploit->SelfEndName} = $exploit;
  2153.         
  2154.         push @{ $moduleTypes->{'exploits'}->{$exploit->ModuleClass} }, $exploit->SelfEndName;
  2155.         
  2156.         foreach my $kname ( @{ $exploit->Keys } ) {
  2157.             push @{ $moduleKeys->{'exploits'}->{$kname} }, $exploit->SelfEndName;
  2158.         }
  2159.  
  2160.         foreach my $kname ( @{ $exploit->OS } ) {
  2161.             push @{ $moduleOS->{'exploits'}->{$kname} }, $exploit->SelfEndName;
  2162.         }
  2163.         
  2164.         foreach my $kname ( @{ $exploit->Arch } ) {
  2165.             push @{ $moduleArch->{'exploits'}->{$kname} }, $exploit->SelfEndName;
  2166.         }                
  2167.     }
  2168.  
  2169.     foreach my $key (keys(%{$payloadsIndex})) {
  2170.         my $payload = $payloadsIndex->{$key};
  2171.         
  2172.         $payloads->{$payload->SelfEndName} = $payload;
  2173.         $modules->{'payloads'}->{$payload->SelfEndName} = $payload;
  2174.         
  2175.         foreach my $kname ( @{ $payload->OS } ) {
  2176.             push @{ $moduleOS->{'payloads'}->{$kname} }, $payload->SelfEndName;
  2177.         }
  2178.         
  2179.         foreach my $kname ( @{ $payload->Arch } ) {
  2180.             push @{ $moduleArch->{'payloads'}->{$kname} }, $payload->SelfEndName;
  2181.         }                
  2182.     }
  2183.  
  2184.     $ui->SetTempEnv('_ExploitsIndex', $exploitsIndex);
  2185.     $ui->SetTempEnv('_PayloadsIndex', $payloadsIndex);
  2186.     $ui->SetTempEnv('_Encoders', $encodersIndex);
  2187.     $ui->SetTempEnv('_Nops', $nopsIndex);
  2188.     $ui->SetTempEnv('_UI', $ui);
  2189. }
  2190.  
  2191.  
  2192.  
  2193. ####################
  2194. package GhettoWeb; #
  2195. ####################
  2196.  
  2197. use POSIX;
  2198. use IO::Socket;
  2199. use IO::Select;
  2200. use Pex;
  2201.  
  2202. sub new {
  2203.     my $name    = shift;
  2204.     my $self    = bless {}, $name;
  2205.     $self->_config(@_);
  2206.     $self->{'_Session'} = { };
  2207.     $self->{'_LastSession'} = 0;    
  2208.     return $self;
  2209. }
  2210.  
  2211. sub _config {
  2212.     my $self = shift;
  2213.     my %args = @_;
  2214.     foreach (keys %args) {
  2215.         $self->{'_Config'}->{$_} = $args{$_};
  2216.     }
  2217. };
  2218.  
  2219. sub SessionNext {
  2220.     my $self = shift;
  2221.     my $curr = $self->{'_LastSession'};
  2222.     $self->{'_LastSession'} = $curr + 1;
  2223.  
  2224.     return $self->{'_LastSession'};
  2225. }
  2226.  
  2227. sub SessionNew {
  2228.     my $self    = shift;
  2229.     my $ipc        = shift;
  2230.     my $sid     = $self->SessionNext;
  2231.     
  2232.     $self->{'_Session'}->{$sid} =
  2233.     {
  2234.         'IPC'    => $ipc,
  2235.         'PID'    => 0,
  2236.         'Data'    => '',
  2237.     };
  2238.     $self->Log(1, "IPC: creating new session $sid with IPC socket $ipc");    
  2239.     return $sid;
  2240. }
  2241.  
  2242. sub SessionDataGet {
  2243.     my $self = shift;
  2244.     my $sid  = shift;
  2245.     
  2246.     return if ! exists($self->{'_Session'}->{$sid});
  2247.  
  2248.     my $data = $self->{'_Session'}->{$sid}->{'Data'};
  2249.     $self->{'_Session'}->{$sid}->{'Data'} = '';
  2250.     return $data;    
  2251. }
  2252.  
  2253. sub SessionDataPut {
  2254.     my $self = shift;
  2255.     my $sid  = shift;
  2256.     my $data = shift;
  2257.     
  2258.     return if ! exists($self->{'_Session'}->{$sid});
  2259.  
  2260.     $self->{'_Session'}->{$sid}->{'Data'} .= $data;
  2261.     return length($self->{'_Session'}->{$sid}->{'Data'});
  2262. }
  2263.  
  2264. sub SessionPipePID {
  2265.     my $self = shift;
  2266.     my $sid  = shift;
  2267.     
  2268.     return if ! exists($self->{'_Session'}->{$sid});
  2269.     $self->{'_Session'}->{$sid}->{'PID'} = shift if @_;
  2270.     return $self->{'_Session'}->{$sid}->{'PID'};
  2271. }
  2272.  
  2273. sub SessionIPC {
  2274.     my $self = shift;
  2275.     my $sid  = shift;
  2276.     
  2277.     return if ! exists($self->{'_Session'}->{$sid});
  2278.     $self->{'_Session'}->{$sid}->{'IPC'} = shift if @_;
  2279.     return $self->{'_Session'}->{$sid}->{'IPC'};
  2280. }
  2281.  
  2282. sub SessionRemove { 
  2283.     my $self = shift;    
  2284.     my $sid  = shift;
  2285.     
  2286.     return if ! exists($self->{'_Session'}->{$sid});
  2287.     
  2288.     # shut down the pipe process
  2289.     if ((my $pid = $self->SessionPipePID($sid))) {
  2290.         $self->Log(3, "IPC: removing session $sid with Pipe PID $pid");
  2291.         kill(9, $pid);
  2292.     }
  2293.     
  2294.     # shut down the ipc channel
  2295.     eval { $self->SessionIPC->close };
  2296.     
  2297.     # remove the entry from the session list
  2298.     delete($self->{'_Session'}->{$sid});
  2299.  
  2300.     return;
  2301. }
  2302.  
  2303. sub SessionList { 
  2304.     my $self = shift;
  2305.     return keys %{ $self->{'_Session'} };
  2306. }
  2307.  
  2308. sub SessionInfo {
  2309.     my $self = shift;
  2310.     my $sid  = shift;
  2311.     
  2312.     return if ! exists($self->{'_Session'}->{$sid});
  2313.     $self->{'_Session'}->{$sid}->{'Info'} = shift if @_;
  2314.     return $self->{'_Session'}->{$sid}->{'Info'};
  2315. }
  2316.  
  2317. sub SessionCheck { 
  2318.     my $self = shift;    
  2319.     my $sid  = shift;
  2320.     return 0 if ! exists($self->{'_Session'}->{$sid});
  2321.     return 1;
  2322. }
  2323.  
  2324. sub IsError {
  2325.     my $self = shift;
  2326.     return 1 if exists($self->{'_Error'});
  2327.     return;
  2328. }
  2329.  
  2330. sub GetError {
  2331.     my $self = shift;
  2332.     return if ! exists($self->{'_Error'});
  2333.     return $self->{'_Error'};
  2334. }
  2335.  
  2336. sub SetError {
  2337.     my $self = shift;
  2338.     my $boom = shift;
  2339.     $self->{'_Error'} = $boom;
  2340.     return $self->{'_Error'};
  2341. }
  2342.  
  2343. sub ClearError {
  2344.     my $self = shift;
  2345.     delete($self->{'_Error'});
  2346. }
  2347.  
  2348. sub LogFile {
  2349.     my $self = shift;
  2350.     $self->{'_LogFile'} = shift() if @_;
  2351.     return $self->{'_LogFile'};
  2352. }
  2353.  
  2354. sub LogLevel {
  2355.     my $self = shift;
  2356.     $self->{'_LogLevel'} = shift() if @_;
  2357.     return $self->{'_LogLevel'};
  2358. }
  2359.  
  2360. sub Log {
  2361.     my $self    = shift;
  2362.     my $lvl        = shift;
  2363.     my $msg        = @_ ? shift() : return;
  2364.     
  2365.     return if $lvl > $self->LogLevel;
  2366.     
  2367.     if (! open(X, ">>".$self->LogFile) ) {
  2368.         print STDERR "FATAL: could not open the log file '". $self->LogFile ."': $!\n";
  2369.         exit(0);
  2370.     }
  2371.     
  2372.     binmode(X);
  2373.     
  2374.     $msg = $self->TermEscape($msg);
  2375.     
  2376.     print X scalar(localtime())." <$lvl> $msg\n";
  2377.     close(X);
  2378. }
  2379.  
  2380. sub TermEscape {
  2381.     my $self = shift;
  2382.     my $data = shift;
  2383.     my $res;
  2384.     
  2385.     foreach my $c (unpack('C*', $data)) {
  2386.         if ($c >= 0x20 && $c < 0x80) {    $res .= chr($c); }
  2387.         else { $res .= sprintf("\\x%.2x", $c); }
  2388.     }
  2389.     return $res;
  2390. }
  2391.  
  2392. sub Run {
  2393.     my $self = shift;
  2394.     my $args = $self->{'_Config'};
  2395.  
  2396.     my $host  = $args->{'host'};
  2397.     my $port  = $args->{'port'};
  2398.     my $fnWeb = $args->{'fnWeb'} || sub { };
  2399.     my $fnIPC = $args->{'fnIPC'} || sub { };
  2400.     my $fnHRP = $args->{'fnHRP'} || sub { };
  2401.     
  2402.     my $httpd = IO::Socket::INET->new 
  2403.     (
  2404.         LocalAddr => $host,
  2405.         LocalPort => $port,
  2406.         ReuseAddr => 1,
  2407.         Listen    => 5,
  2408.     );
  2409.     
  2410.     if (! $httpd) {
  2411.         $self->SetError("Failed to start listener: $!");
  2412.         return;
  2413.     }
  2414.     
  2415.     $httpd->blocking(0);
  2416.  
  2417.     $SIG{'CHLD'} = \&_Reaper;
  2418.  
  2419.     my %socketInfo = 
  2420.     (
  2421.         $httpd    => [$httpd, 0, 'listener'],
  2422.     );
  2423.  
  2424.     my $keepRunning = 1;
  2425.     
  2426.     # The main event loop
  2427.     while ($keepRunning) {
  2428.  
  2429.         my $sel = IO::Select->new();
  2430.  
  2431.         foreach my $s (keys %socketInfo) {
  2432.             # Process all but child-side sockets
  2433.             if ($socketInfo{$s}->[2] ne 'ipc_child') {
  2434.                 my $sd = $socketInfo{$s}->[0];
  2435.  
  2436.                 if (! $sd) {
  2437.                     $self->Log(1, "ERROR: socketInfo{ $s } is invalid");
  2438.                     delete($socketInfo{$s});
  2439.                     next;
  2440.                 }
  2441.  
  2442.                 $sd->blocking(0);
  2443.                 $sd->autoflush(1);
  2444.                 $sel->add($sd);
  2445.             }
  2446.         }
  2447.  
  2448.         # Select for new connections and data
  2449.         my @ready = $sel->can_read(10);
  2450.  
  2451.         # Process each flagged socket
  2452.         foreach my $s (@ready) {
  2453.  
  2454.             # A new connection
  2455.             if ($s eq $httpd) {
  2456.                 my ($client) = $httpd->accept;
  2457.                 
  2458.                 if (! $client) {
  2459.                     $self->Log(1,  "ERROR: accept failed on primary listener socket: $@");
  2460.                     next;
  2461.                 }
  2462.  
  2463.                 $socketInfo{$client} = [$client, 0, 'client'];
  2464.                 $self->Log(4, "NEW: ".$client->peerhost .':'. $client->peerport);
  2465.                 next;
  2466.             }
  2467.  
  2468.             # A new HTTP request
  2469.             if ($socketInfo{$s}->[2] eq 'client') {
  2470.                 my $cli = Msf::Socket::Tcp->new_from_socket($s);
  2471.                 my $cinfo = $cli->PeerAddr .':'. $cli->PeerPort;
  2472.                 
  2473.                 # Process the actual HTTP request
  2474.                 my $res = $fnHRP->($self, $cli);
  2475.                 
  2476.                 # Ignore requests that resulted in 'not modified' responses
  2477.                 if ( $res->{'cached'} ) {
  2478.                     $self->Log(5,  "HTTP: cache hit from $cinfo");
  2479.                     eval { $s->shutdown(2); $s->close; };
  2480.                     next;
  2481.                 }
  2482.             
  2483.                 # Check for cache blocking (detected possible DoS)
  2484.                 if ($res->{'cache_block'}) {
  2485.                     $self->Log(3,  "HTTP: cache denial of service attack from $cinfo");
  2486.                     eval { $s->shutdown(2); $s->close; };    
  2487.                     next;
  2488.                 }
  2489.                 
  2490.                 if ($res->{'invalid'}) {
  2491.                     $self->Log(3,  "HTTP: invalid request from $cinfo");        
  2492.                     eval { $s->shutdown(2); $s->close; };
  2493.                     next;
  2494.                 }
  2495.             
  2496.                 if ($res->{'oversized'}) {
  2497.                     $self->Log(3,  "HTTP: oversized request from $cinfo");        
  2498.                     eval { $s->shutdown(2); $s->close; };
  2499.                     next;            
  2500.                 }
  2501.             
  2502.                 
  2503.                 
  2504.                 if ($res) {
  2505.                     my ($par, $chi);
  2506.  
  2507.                     # Do not create IPC pipes for resource requests
  2508.                     if ($res->{'base'} ne 'RESOURCE') {
  2509.                         # Create the comm channel between parent and child
  2510.                         socketpair($par, $chi, AF_UNIX, SOCK_STREAM, PF_UNSPEC);
  2511.                     }
  2512.                     
  2513.                     # Spawn off the child process
  2514.                     my $pid = fork();
  2515.                     if (! $pid) {
  2516.                         # Reseed the PRNG
  2517.                         srand();
  2518.                         
  2519.                         # Close the http listener inside the child
  2520.                         $httpd->close;                    
  2521.                         $fnWeb->($self, $res, $cli, $chi);
  2522.                         exit(0);
  2523.                     }
  2524.                     
  2525.                     # Do not track IPC pipes for resource requests
  2526.                     if ($res->{'base'} ne 'RESOURCE') {
  2527.                         $socketInfo{$par} = [$par, $pid, 'ipc'];
  2528.                         $socketInfo{$chi} = [$chi, $pid, 'ipc_child'];
  2529.                     }
  2530.                     
  2531.                 } 
  2532.                 
  2533.                 # XXX - local cleanup up the original socket?
  2534.                 delete($socketInfo{$s});
  2535.                 next;
  2536.             }
  2537.  
  2538.             # A new IPC request
  2539.             if ($socketInfo{$s}->[2] eq 'ipc') {
  2540.                 my $ipc_pid = $socketInfo{$s}->[1];
  2541.                 $self->Log(3,  "IPC: $ipc_pid $s");
  2542.                 $fnIPC->($self, $s);
  2543.                 next;
  2544.             }
  2545.  
  2546.             # Unknown socket type...
  2547.             $self->Log(1, "ERROR: unknown socket type ".$socketInfo{$s}->[2]);
  2548.         }
  2549.  
  2550.         # Remove sockets attach to dead processes
  2551.         foreach my $s (keys %socketInfo) {
  2552.             my $spid = $socketInfo{$s}->[1];
  2553.             if ($spid && ! kill(0, $spid)) {
  2554.                 $self->Log(4, "DEL: $s $spid ".$socketInfo{$s}->[2]);
  2555.                 eval 
  2556.                 { 
  2557.                     $socketInfo{$s}->[0]->shutdown(2); 
  2558.                     $socketInfo{$s}->[0]->close;
  2559.                 };
  2560.                 delete($socketInfo{$s});
  2561.                 waitpid(-1, WNOHANG);
  2562.             }
  2563.         }
  2564.         
  2565.         # Resolve an annoying issue with Cygwin...
  2566.         next;
  2567.     }
  2568. }
  2569.  
  2570. # Reinstate the signal handler for SysV boxes...
  2571. sub _Reaper {
  2572.     while (waitpid(-1, WNOHANG) == 0) { }
  2573.     $SIG{'CHLD'} = \&_Reaper;
  2574. }
  2575.  
  2576. 1;
  2577.